From 0286c2df0391f7c15a296ab13c19d25aaecfeb6f Mon Sep 17 00:00:00 2001 From: gered Date: Wed, 7 Jul 2021 17:10:18 -0400 Subject: [PATCH] initial commit of "completed" sources, binaries and assets as of july 4th, 2021 --- ASSETS.PAS | 180 ++++ CHUNKY.FNT | Bin 0 -> 2305 bytes DESIGN.TXT | 93 ++ DP.FNT | Bin 0 -> 2305 bytes DRAW.PAS | 489 ++++++++++ EDGES.MAP | Bin 0 -> 270 bytes ENTITIES.PAS | 1121 +++++++++++++++++++++++ FRUITPOP.EXE | Bin 0 -> 95543 bytes FRUITPOP.PAS | 119 +++ FRUITSEL.PAS | 127 +++ GDLIB/FIXEDP.PAS | 193 ++++ GDLIB/GDCLIP.PAS | 392 ++++++++ GDLIB/GDEVENTS.PAS | 229 +++++ GDLIB/GDGFX.PAS | 2140 ++++++++++++++++++++++++++++++++++++++++++++ GDLIB/GDIFF.PAS | 709 +++++++++++++++ GDLIB/GDKEYBRD.PAS | 417 +++++++++ GDLIB/GDKEYCHR.PAS | 192 ++++ GDLIB/GDMOUSE.PAS | 473 ++++++++++ GDLIB/GDPCX.PAS | 356 ++++++++ GDLIB/GDTIMER.PAS | 198 ++++ GDLIB/MATH.PAS | 543 +++++++++++ GDLIB/MATHFP.PAS | 528 +++++++++++ GDLIB/TOOLBOX.PAS | 513 +++++++++++ HELP.PAS | 139 +++ IMAGES.LBM | Bin 0 -> 17758 bytes LEVELSEL.PAS | 189 ++++ MAINMENU.PAS | 124 +++ MAPEDIT.PAS | 142 +++ MAPS.PAS | 260 ++++++ MATCH.PAS | 237 +++++ RESULTS.PAS | 125 +++ SHARED.PAS | 315 +++++++ SIMPLE.MAP | Bin 0 -> 270 bytes SMALL.MAP | Bin 0 -> 270 bytes TEST.MAP | Bin 0 -> 270 bytes TILES.LBM | Bin 0 -> 28790 bytes 36 files changed, 10543 insertions(+) create mode 100644 ASSETS.PAS create mode 100644 CHUNKY.FNT create mode 100644 DESIGN.TXT create mode 100644 DP.FNT create mode 100644 DRAW.PAS create mode 100644 EDGES.MAP create mode 100644 ENTITIES.PAS create mode 100644 FRUITPOP.EXE create mode 100644 FRUITPOP.PAS create mode 100644 FRUITSEL.PAS create mode 100644 GDLIB/FIXEDP.PAS create mode 100644 GDLIB/GDCLIP.PAS create mode 100644 GDLIB/GDEVENTS.PAS create mode 100644 GDLIB/GDGFX.PAS create mode 100644 GDLIB/GDIFF.PAS create mode 100644 GDLIB/GDKEYBRD.PAS create mode 100644 GDLIB/GDKEYCHR.PAS create mode 100644 GDLIB/GDMOUSE.PAS create mode 100644 GDLIB/GDPCX.PAS create mode 100644 GDLIB/GDTIMER.PAS create mode 100644 GDLIB/MATH.PAS create mode 100644 GDLIB/MATHFP.PAS create mode 100644 GDLIB/TOOLBOX.PAS create mode 100644 HELP.PAS create mode 100644 IMAGES.LBM create mode 100644 LEVELSEL.PAS create mode 100644 MAINMENU.PAS create mode 100644 MAPEDIT.PAS create mode 100644 MAPS.PAS create mode 100644 MATCH.PAS create mode 100644 RESULTS.PAS create mode 100644 SHARED.PAS create mode 100644 SIMPLE.MAP create mode 100644 SMALL.MAP create mode 100644 TEST.MAP create mode 100644 TILES.LBM diff --git a/ASSETS.PAS b/ASSETS.PAS new file mode 100644 index 0000000..c1825f6 --- /dev/null +++ b/ASSETS.PAS @@ -0,0 +1,180 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Assets; + +interface + +uses GDGfx, GDIFF, Maps, Shared; + +type + UIFrameBitmaps = array[0..9] of PBitmap; + +var + pal : Palette; + fnt : Font; + chunkyFnt : Font; + tiles : array[0..99] of PBitmap; + sprites : array[0..99] of PBitmap; + + titleMain : PBitmap; + titleSelectLevel : PBitmap; + titleChooseFruit : PBitmap; + titleHelp : PBitmap; + titleResults : PBitmap; + titlePause : PBitmap; + + uiTomatoFrame : UIFrameBitmaps; + uiGrapesFrame : UIFrameBitmaps; + uiGeneralFrame : UIFrameBitmaps; + +function LoadTilesAndSprites(filename : string) : boolean; +function LoadImages(filename : string) : boolean; +function LoadMap(filename : string) : boolean; + +implementation + +uses Toolbox; + +function LoadTilesAndSprites(filename : string) : boolean; +var + i, x, y, offset : integer; + puiFrame : ^UIFrameBitmaps; +label return; +begin + LoadTilesAndSprites := false; + + UseLayer(BACKBUFFER_LAYER); + if LoadIFF(filename, @pal) <> IFFOk then goto return; + + { environment tiles are on the left } + offset := 0; + i := 0; + for y := 0 to 9 do begin + for x := 0 to 9 do begin + AllocBitmap(16, 16, tiles[i]); + GrabBitmap((x*16)+offset, y*16, 16, 16, tiles[i]); + inc(i); + end; + end; + + { sprites are on the right } + offset := 160; + i := 0; + for y := 0 to 9 do begin + for x := 0 to 9 do begin + AllocBitmap(16, 16, sprites[i]); + GrabBitmap((x*16)+offset, y*16, 16, 16, sprites[i]); + inc(i); + end; + end; + + { other things that are not in a uniform 16x16 grid } + for i := 0 to 2 do begin + case i of + 0: puiFrame := @uiTomatoFrame; + 1: puiFrame := @uiGrapesFrame; + 2: puiFrame := @uiGeneralFrame; + end; + + x := i * 48; + + AllocBitmap(16, 16, puiFrame^[0]); + AllocBitmap(8, 8, puiFrame^[1]); + AllocBitmap(16, 16, puiFrame^[2]); + AllocBitmap(8, 8, puiFrame^[3]); + AllocBitmap(8, 8, puiFrame^[4]); + AllocBitmap(8, 8, puiFrame^[5]); + AllocBitmap(16, 16, puiFrame^[6]); + AllocBitmap(8, 8, puiFrame^[7]); + AllocBitmap(16, 16, puiFrame^[8]); + + GrabBitmap(x+0, 176, 16, 16, puiFrame^[0]); + GrabBitmap(x+16, 176, 8, 8, puiFrame^[1]); + GrabBitmap(x+32, 176, 16, 16, puiFrame^[2]); + GrabBitmap(x+0, 184, 8, 8, puiFrame^[3]); + GrabBitmap(x+8, 184, 8, 8, puiFrame^[4]); + GrabBitmap(x+40, 184, 8, 8, puiFrame^[5]); + GrabBitmap(x+0, 184, 16, 16, puiFrame^[6]); + GrabBitmap(x+16, 192, 8, 8, puiFrame^[7]); + GrabBitmap(x+32, 184, 16, 16, puiFrame^[8]); + end; + + LoadTilesAndSprites := true; + +return: + UseLayer(SCREEN_LAYER); +end; + +function LoadImages(filename : string) : boolean; +label return; +begin + LoadImages := false; + + UseLayer(BACKBUFFER_LAYER); + if LoadIFF(filename, nil) <> IFFOk then goto return; + + AllocBitmap(98, 38, titlePause); + GrabBitmap(3, 2, 98, 38, titlePause); + + AllocBitmap(124, 39, titleResults); + GrabBitmap(121, 2, 124, 39, titleResults); + + AllocBitmap(164, 37, titleSelectLevel); + GrabBitmap(2, 42, 164, 37, titleSelectLevel); + + AllocBitmap(262, 35, titleChooseFruit); + GrabBitmap(2, 79, 262, 35, titleChooseFruit); + + AllocBitmap(196, 40, titleHelp); + GrabBitmap(2, 112, 196, 40, titleHelp); + + AllocBitmap(272, 48, titleMain); + GrabBitmap(2, 150, 272, 48, titleMain); + + LoadImages := true; + +return: + UseLayer(SCREEN_LAYER); +end; + +function LoadMap(filename : string) : boolean; +var + f : file; + n : integer; + header : array[0..2] of char; +label ioError; +begin + LoadMap := false; + + Assign(f, filename); + + Reset(f, 1); + if IOResult <> 0 then begin + Close(f); + n := IOResult; { clear i/o error flag } + exit; + end; + + { validate file type by checking for expected header } + BlockRead(f, header, SizeOf(header)); + if (header[0] <> 'M') or (header[1] <> 'A') or (header[2] <> 'P') then + goto ioError; + + MemFill(@map, 0, SizeOf(map)); + BlockRead(f, map, SizeOf(map), n); + if n <> SizeOf(map) then goto ioError; + + isMapDirty := true; + LoadMap := true; + Close(f); + n := IOResult; { clear i/o error flag } + exit; + +ioError: + LoadMap := false; + Close(f); + n := IOResult; { clear i/o error flag } +end; + + +end. diff --git a/CHUNKY.FNT b/CHUNKY.FNT new file mode 100644 index 0000000000000000000000000000000000000000..56376ddc6fa7e6c2301eb667ab1c2244f690e280 GIT binary patch literal 2305 zcmeHEA#%hp3>0gDA7D_>2NVbz78LXuh6MqI27w3fQ33}A3Ih%n78DwIZn|2huejJV zS+BK{rH#n3=s+n&3Qo)NM!wvzMIP6$_R?QPeAC4dX|`;*7u9EcMY5`9pyr$v=xwyn zsSXW}H3Kpxix5sJYc*hV_XgBY)xe%g4duu!bzo`Ri2B1id9zOaK!K>!9Gkc@j!WJX zYxGyyAD(9envn=S-Vx@Xzt1z@NA%qt8@QU;O77%%-`E$>7{7YN9clChK17|Tl-Q4N zzgyg+4D(LA&VR<0`hD(>@&+Azps&FrzS^80E^;2oXI((_4LaV5$ec*sz`)UGtF=Zy jhVfHy{GZ_Zalv + +Emojis Selected: Tomato / Thumbtack / Two Users / Grapes + +-------- CONCEPT ------------------------------------------------------------ +"Head-to-Head Fruit Popper" + +Play against a friend (or the computer), squaring-off in a garden with fruit +magically growing quickly and at random. Be the fastest to pop the most fruit +with your magical thumb-tack within the time limit! Your thumb-tack has been +magically attuned to only one of two different types of fruit, while your +opponent will be seeking out the opposite type of fruit. + + +-------- PRESENTATION ------------------------------------------------------- +2D, top-down, single-screen arena. Kind of like Bomberman without the bombs? +Players represented by character sprites that they control directly to move +around the arena. The arena will have different (non-hazardous?) obstacles +(walls), and fruit will be randomly spawning / dropping-in / etc as the game +timer counts down. + +16x16 sprites/tiles. +MS-DOS VGA Mode 13h. + + +-------- CONTROLS ----------------------------------------------------------- + +Keyboard. + +Single-player: + - Arrow keys for movement, 4 directional, N/S/E/W. + - Spacebar to use thumb-tack. + +Two-player: + - Player 1: + - Arrow keys / Num-pad for movement. + - Num-pad 0 / Num-pad Enter to use thumb-tack. + + - Player 2: + - ASDW for movement + - Spacebar to use thumb-tack. + +Nice extra: Allow use of game controller (e.g. Gravis Gamepad). + + +-------- GAMEPLAY ----------------------------------------------------------- + +Players select their preferred fruit. Cannot be the same selection, so once +one player selects a fruit, the other player is automatically assigned the +other. Tomato or Grape. + +Once the match begins, the main objective is to pop the most fruit matching +the player's fruit of choice. + +Popping the right fruit does not cause any penalty or other sort of effect +to the other player, it simply increments the players score and the fruit +vanishes. + +Popping the wrong fruit does not cause a penalty for the player that popped +it, but the player receives no score for it. + +However, popping the wrong fruit causes your magically attuned thumbtack to +trigger the fruit to explode, which does not harm you, but will "splash" +toxic fruit juice over a 3x3 (TBD) tile area which will debuff the other +player if they are within that area, causing them to move at 50% speed until +the debuff wears off (2-3 seconds? TBD). Additionally, any other fruit of the +same type within a 5x5 (TBD) tile area will magically vanish. So players may +want to strategically pop the other players fruit to deny them score and slow +them down. + +Players can "prick" each other with their thumbtacks. Players cannot be killed +but they can use their thumbtacks to push the other player out of the way +slightly, possibly also throwing them off a bit in the process. Pricking +another player causes them to get pushed ahead by 1-2 tiles, but causes no +other harm. + +Matches are timed. Once the match is over, the score is displayed, and the +winner is the player who popped the most fruit. + + +-------- EXTRAS ------------------------------------------------------------- + +If time allows ... + +- Sound effects. Use of Qbasic "SoundLab" utility to generate sound effects? +- Gravis Gamepad support +- Network play? Use of mTCP? Almost certainly won't have time for this ... +- Random "enemies" that spawn and snatch fruit before the players can get + them? Mutant-oversized fruit flys perhaps ... ? Or some kind of Locust + swarm maybe? + diff --git a/DP.FNT b/DP.FNT new file mode 100644 index 0000000000000000000000000000000000000000..038ecc6d0b241b9da97978e6270f53c837db2654 GIT binary patch literal 2305 zcmeHGy=vqz5FWBWb|I3KhJ>r~0D@~=hy?N&sRRqY#zm@NIGuO%82bSC7y-e8Dv>fQ zWLaEgyWlFgFmk?;lWVWM;xb-)G@5U|8GZH=jaJ|PzJFNX*Y)r`Yz{+Rh7e4CN~gJr zJ~ugUnA35?5M@ebM8j~{06&l_uCEJ4!)E>Pu-*(O$;mJ8eWi+`P+6T_eZP|Owr!S+ zvj-jW1C?>%+i^N$RUWv$^D)}g=cEan=$jrpB7ge1y5wLCuN|Ar}f zPUpAn);nSru5+*9$vH>vyn#i2=5h%72$G=7O0+D8GXVOb*Hu>hzW@yy5PALGtOJ`fV^8s_2t`0z;U z9_0!#;BgKv;}44kV7@58n8!SL$q=BYb154s&xyJC<^WrCw*!=og>d}G__8krz7+Uh z6-fVLv&lS7(sVkTrO7mzr0Fb4(u8d?ohS2;HNsiSxR}9%gBh-L`nfZiC(}Ra5jlbT G=k^Y8n7@Mn literal 0 HcmV?d00001 diff --git a/DRAW.PAS b/DRAW.PAS new file mode 100644 index 0000000..b8c3924 --- /dev/null +++ b/DRAW.PAS @@ -0,0 +1,489 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Draw; + +interface + +uses GDGfx, Entities, Assets; + +procedure DrawMap; +procedure DrawPlayer(const player : Player); +procedure DrawAllFruit; +procedure DrawAllParticles; +procedure DrawGameStatusBackdrop; +procedure DrawPlayerStatuses; +procedure DrawMatchStatus; +procedure DrawBackdrop; + +procedure DrawUIFrame(x1, y1, width, height : integer; + const frameBitmaps : UIFrameBitmaps); + +procedure FadeOut; +procedure FadeIn; +procedure FadeOutAndIn(delay : word); +procedure BlackOutPalette; + +procedure BlitSpriteScaled(x, y: integer; xs, ys: word; const bmp: PBitmap); + +implementation + +uses GDTimer, FixedP, Toolbox, Maps, Shared; + +const + TOMATO_X = 0; + GRAPES_X = 208; + GENERAL_X = 112; + STATUS_Y = 176; + +procedure DrawMap; +var + x, y : word; + currentMapTile : ^byte; + oldLayer : integer; +begin + oldLayer := GetBoundLayerIndex; + UseLayer(SCREEN_MAP_LAYER); + + currentMapTile := @map.map[0]; + for y := 0 to 10 do begin + for x := 0 to 19 do begin + Blitf(x*16, y*16, tiles[currentMapTile^]); + inc(currentMapTile); + end; + end; + + UseLayer(oldLayer); + isMapDirty := false; +end; + +procedure DrawPlayer(const player : Player); +var + playerIndex, thumbTackIndex : word; + tx, ty : integer; + dir : Direction; + fruit : FruitKind; + skip : boolean; +begin + with player do begin + dir := entity.direction; + fruit := fruitPref; + + skip := ((stabbedDebuffTime > 0) or (splashedDebuffTime > 0)) and skipRenderFlag; + + { compute the current final sprite index from the player's + current animation state and facing direction. + note that this value still needs to be added to playerSpriteOffsets + to get the real final sprite index for the correct player sprite set + (based on the player's chosen fruit type). } + playerIndex := GetAnimationFrame( + entity.animation, + playerAnimations[ord(state)], + dir + ); + + { if the player is currently stabbing, then also get the thumbtack + sprite index to use } + if state = Stabbing then begin + thumbTackIndex := ord(dir) + thumbTackSpriteOffsets[ord(fruit)]; + end; + end; + + with player.entity.position do begin + if player.state = Stabbing then begin + { the player is currently stabbing with their thumb tack, so we + need to render the thumb tack sprite too. the exact position + of the thumb tack sprite varies depending on the player's + facing direction (so as to position it in the player's hand) } + GetThumbTackRenderCoords(player, tx, ty); + + if dir = North then begin + { if we're facing north, the thumb tack sprite should be + rendered first, so that it is layered underneath the player + sprite } + BlitSpritef(tx, ty, sprites[thumbTackIndex]); + + if not skip then + BlitSpritef( + FixToInt(x), + FixToInt(y), + sprites[playerIndex + playerSpriteOffsets[ord(fruit)]] + ); + end else begin + { but for every other direction, render the thumb tack sprite + layered on top of the player sprite } + if not skip then + BlitSpritef( + FixToInt(x), + FixToInt(y), + sprites[playerIndex + playerSpriteOffsets[ord(fruit)]] + ); + + BlitSpritef(tx, ty, sprites[thumbTackIndex]); + end; + end else begin + { not stabbing, so just render the player sprite itself } + if not skip then + BlitSpritef( + FixToInt(x), + FixToInt(y), + sprites[playerIndex + playerSpriteOffsets[ord(fruit)]] + ); + end; + end; +end; + +procedure DrawAllFruit; +var + i, index : word; + value, offset : integer; +begin + for i := 0 to numDirtTiles-1 do begin + with dirtTiles[i] do begin + if not hasFruit then continue; + + { compute the final sprite index of the fruit based on its current + animation. note that not all states of the fruit entity actually + use real "animations" ... some are just an animation sequence of + 1 frame, and is just being abused to fit into this general + framework ... :-) } + with fruit do begin + index := GetAnimationFrame( + entity.animation, + fruitAnimations[ord(state)], + South + ); + end; + + case fruit.state of + Plant: begin + { just a simple plant } + with fruit.entity.position do begin + BlitSpritef(FixToInt(x), FixToInt(y), sprites[index]); + end; + end; + + Growing: begin + { render the fruit sprite, scaled. } + if fruit.isGold then inc(index, GOLD_FRUIT_TILE_OFFSET); + + with fruit.entity.position do begin + value := fruit.value; { the pixel width/height of the + fruit sprite } + offset := 8-(value div 2); { the x/y coordinate offset used + to center the fruit sprite + within the map tile it is on } + + BlitSpriteScaled( + FixToInt(x) + offset, + FixToInt(y) + offset, + value, + value, + sprites[index + fruitSpriteOffsets[ord(fruit.kind)]] + ); + end; + end; + + Grown, Popped: begin + { render the fruit sprite } + if fruit.isGold then inc(index, GOLD_FRUIT_TILE_OFFSET); + + with fruit.entity.position do begin + BlitSpritef( + FixToInt(x), + FixToInt(y), + sprites[index + fruitSpriteOffsets[ord(fruit.kind)]] + ); + end; + end; + end; + end; + end; +end; + +procedure DrawAllParticles; +var + i, index : word; +begin + for i := 0 to MAX_PARTICLES-1 do begin + with particles[i] do begin + if not active then continue; + + if animation <> nil then begin + { particle is a "sprite-animated" particle type. get its current + "final" sprite index based on its animation state } + index := GetAnimationFrame( + entity.animation, + animation^, + entity.direction + ); + + with entity.position do begin + BlitSpritef(FixToInt(x), FixToInt(y), sprites[index]); + end; + + end else begin + { TODO: "pixel" particle types ... } + + end; + end; + end; +end; + +procedure DrawGameStatusBackdrop; +var + i, oldLayer : integer; +begin + oldLayer := GetBoundLayerIndex; + UseLayer(SCREEN_MAP_LAYER); + + { tomato player status } + DrawUIFrame(TOMATO_X, STATUS_Y, 112, 24, uiTomatoFrame); + BlitSpritef(TOMATO_X+8, STATUS_Y+4, sprites[PLAYER_TOMATO_TILE_START]); + BlitSpritef(TOMATO_X+28, STATUS_Y+4, sprites[FRUIT_TOMATO_TILE_START]); + + + { grapes player status } + DrawUIFrame(GRAPES_X, STATUS_Y, 112, 24, uiGrapesFrame); + BlitSpritef((SCREEN_RIGHT-16)-8, STATUS_Y+4, sprites[PLAYER_GRAPES_TILE_START]); + BlitSpritef((SCREEN_RIGHT-16)-28, STATUS_Y+4, sprites[FRUIT_GRAPES_TILE_START]); + + + { general match info } + DrawUIFrame(GENERAL_X, STATUS_Y, 96, 24, uiGeneralFrame); + + UseLayer(oldLayer); + isStatusBackdropDirty := false; +end; + +procedure DrawPlayerStatuses; +const + TEXT_Y = STATUS_Y+13; +var + x, value : integer; + s : string[3]; +begin + UseFont(@chunkyFnt); + + with tomatoPlayer^ do begin + { number of popped tomatoes } + Str(score:3, s); + DrawStringf(TOMATO_X+28, TEXT_Y, TOMATO_TEXT_COLOR, s); + + x := TOMATO_X+56; + + { 'stabbed' debuff icon and time left } + if stabbedDebuffTime > 0 then begin + BlitSpritef(x, STATUS_Y+4, sprites[GRAPES_THUMBTACK_TILE]); + + value := stabbedDebuffTime div 1000; + Str(value:3, s); + DrawStringf(x, TEXT_Y, DEBUFF_TEXT_COLOR, s); + + inc(x, 28); + end; + + + { 'splashed' debuff icon and time left } + if splashedDebuffTime > 0 then begin + BlitSpritef(x, STATUS_Y+4, sprites[SPLASH_GRAPES_TILE_START]); + + value := splashedDebuffTime div 1000; + Str(value:3, s); + DrawStringf(x, TEXT_Y, DEBUFF_TEXT_COLOR, s); + end; + end; + + with grapesPlayer^ do begin + { number of popped tomatoes } + Str(score:3, s); + DrawStringf(GRAPES_X+67, TEXT_Y, GRAPES_TEXT_COLOR, s); + + x := GRAPES_X+67-28; + + { 'stabbed' debuff icon and time left } + if stabbedDebuffTime > 0 then begin + BlitSpritef(x, STATUS_Y+4, sprites[TOMATO_THUMBTACK_TILE]); + + value := stabbedDebuffTime div 1000; + Str(value:3, s); + DrawStringf(x, TEXT_Y, DEBUFF_TEXT_COLOR, s); + + dec(x, 28); + end; + + + { 'splashed' debuff icon and time left } + if splashedDebuffTime > 0 then begin + BlitSpritef(x, STATUS_Y+4, sprites[SPLASH_TOMATO_TILE_START]); + + value := splashedDebuffTime div 1000; + Str(value:3, s); + DrawStringf(x, TEXT_Y, DEBUFF_TEXT_COLOR, s); + end; + end; + + UseFont(nil); +end; + +procedure DrawMatchStatus; +var + totalSeconds, minutes, seconds, seconds10 : word; + s : string[2]; +begin + BlitSpritef(GENERAL_X+8, STATUS_Y+4, sprites[TIMER_SPRITE]); + + UseFont(nil); + PrintAt(GENERAL_X+8+16+6, STATUS_Y+8); + + totalSeconds := matchTime div 1000; + minutes := totalSeconds div 60; + seconds := totalSeconds mod 60; + seconds10 := (matchTime mod 1000) div 100; + + Str(minutes:2, s); + PrintString(s, 15); + + PrintString(':', 15); + + if seconds < 10 then PrintString('0', 15); + PrintWord(seconds, 15); + + PrintString('.', 15); + PrintWord(seconds10, 15); +end; + +procedure DrawBackdrop; +begin + if isMapDirty then DrawMap; + if isStatusBackdropDirty then DrawGameStatusBackdrop; + + CopyLayer(SCREEN_MAP_LAYER); +end; + +procedure DrawUIFrame(x1, y1, width, height : integer; + const frameBitmaps : UIFrameBitmaps); +var + i, n, x, y : integer; + middleTilesX, middleTilesY : integer; +begin + { TODO: this drawing routine will not look so great with dimensions + that are not some multiple of 8 (both width and height) ... } + { smallest reasonable dimensions that could really work given + the tiles we're currently using for these ... } + if width < 24 then width := 24; + if height < 24 then height := 24; + + middleTilesX := (width - (2*8)) div 8; + if middleTilesX < 0 then middleTilesX := 0; + middleTilesY := (height - (2*8)) div 8; + if middleTilesY < 0 then middleTilesY := 0; + + { middle } + for y := 0 to middleTilesY-1 do begin + for x := 0 to middleTilesX-1 do begin + Blitf(x1+8+(x*8), y1+8+(y*8), frameBitmaps[4]); + end; + end; + + { top and bottom border } + for i := 0 to middleTilesX-2 do begin + Blitf(x1+16+(i*8), y1, frameBitmaps[1]); + Blitf(x1+16+(i*8), y1+height-8, frameBitmaps[7]); + end; + + { left and right borders } + for i := 0 to middleTilesY-2 do begin + Blitf(x1, y1+16+(i*8), frameBitmaps[3]); + Blitf(x1+width-8, y1+16+(i*8), frameBitmaps[5]); + end; + + { top-left corner } + BlitSpritef(x1, y1, frameBitmaps[0]); + + { bottom-left corner } + BlitSpritef(x1, y1+height-16, frameBitmaps[6]); + + { top-right corner } + BlitSpritef(x1+width-16, y1, frameBitmaps[2]); + + { bottom-right corner } + BlitSpritef(x1+width-16, y1+height-16, frameBitmaps[8]); +end; + +{ ----------------------------------------------------------------------- } + +procedure FadeOut; +begin + FadeRangeToColor(0, 255, 0, 0, 0, 4); +end; + +procedure FadeIn; +begin + FadeRangeToPalette(0, 255, @pal, 4); +end; + +procedure FadeOutAndIn(delay : word); +var + elapsed : word; +begin + FadeRangeToColor(0, 255, 0, 0, 0, 4); + if delay > 0 then begin + elapsed := 0; + MarkTimer; + while elapsed < delay do begin + inc(elapsed, MarkTimer); + end; + end; + FadeRangeToPalette(0, 255, @pal, 4); +end; + +procedure BlackOutPalette; +begin + FadeRangeToColor(0, 255, 0, 0, 0, 255); +end; + +{ ----------------------------------------------------------------------- } + +procedure BlitSpriteScaled(x, y: integer; xs, ys: word; const bmp: PBitmap); +var + width, height : word; + xStep, yStep : fixed; + xIndex, yIndex : fixed; + srcOffset, destOffset : word; + src, dest : PByteArray; + dx, dy : integer; + pixel : byte; +begin + { TODO: clipping support } + { TODO: re-write the render loop in assembly } + + width := bmp^.Width; + height := bmp^.Height; + + xStep := FixDiv(IntToFix(width), IntToFix(xs)); + yStep := FixDiv(IntToFix(height), IntToFix(ys)); + + dest := GetBoundLayerPointerAt(x, y); + destOffset := 0; + src := ptr(Seg(bmp^.Pixels), Ofs(bmp^.Pixels)); + srcOffset := 0; + + yIndex := 0; + + for dy := 0 to (ys-1) do begin + xIndex := 0; + for dx := 0 to (xs-1) do begin + pixel := src^[srcOffset + FixToInt(xIndex)]; + if pixel > 0 then + dest^[destOffset + dx] := pixel; + + inc(xIndex, xStep); + end; + + inc(yIndex, yStep); + inc(destOffset, SCREEN_WIDTH); + srcOffset := width * FixToInt(yIndex); + end; +end; + +end. diff --git a/EDGES.MAP b/EDGES.MAP new file mode 100644 index 0000000000000000000000000000000000000000..d51037cad91c23a911cbc22864c9afdcd7b72aa4 GIT binary patch literal 270 zcmZvXO$x#=5QQf{t)4h)h*kVnQ()3l~Y{>e}0g@Vs6` zriCJMEj+Ng8Vr7&NZ?rpiFP@$XiYdxSt|4si<4Q3qD+Jk%50g= animation.delay then begin + { move to next frame in the current animation sequence } + time := 0; + if frameIndex = (animation.count-1) then begin + { we're at the last frame in the current animation sequence } + if not animation.loops then begin + complete := true; + end else + frameIndex := 0; + end else + inc(frameIndex); + end; + end; + end; +end; + +{ ------------------------------------------------------------------------ } + +function DoEntitiesOverlap(const a, b : Entity) : boolean; +{ returns true if the given entities overlap fully or partially } +const + EDGE = 2; +var + ax1, ay1, ax2, ay2 : integer; + bx1, by1, bx2, by2 : integer; +begin + DoEntitiesOverlap := false; + + with a.position do begin + ax1 := FixToInt(x)+EDGE; + ay1 := FixToInt(y)+EDGE; + ax2 := ax1 + (ENTITY_SIZE-1)-EDGE; + ay2 := ay1 + (ENTITY_SIZE-1)-EDGE; + end; + with b.position do begin + bx1 := FixToInt(x)+EDGE; + by1 := FixToInt(y)+EDGE; + bx2 := bx1 + (ENTITY_SIZE-1)-EDGE; + by2 := by1 + (ENTITY_SIZE-1)-EDGE; + end; + + if (ay1 < by1) and (ay2 < by1) then + exit; + if (ay1 > by2) and (ay2 > by2) then + exit; + if (ax1 < bx1) and (ax2 < bx1) then + exit; + if (ax1 > bx2) and (ax2 > bx2) then + exit; + + DoEntitiesOverlap := true; +end; + +function DoesEntityOverlap(const entity : Entity; + x1, y1, x2, y2 : integer) : boolean; +{ returns true if the entity partially or fully overlaps with the given + area (specified in pixel coordinates) } +const + EDGE = 2; +var + ex1, ey1, ex2, ey2 : integer; +begin + DoesEntityOverlap := false; + + with entity.position do begin + ex1 := FixToInt(x)+EDGE; + ey1 := FixToInt(y)+EDGE; + ex2 := ex1 + (ENTITY_SIZE-1)-EDGE; + ey2 := ey1 + (ENTITY_SIZE-1)-EDGE; + end; + + if (ey1 < y1) and (ey2 < y1) then + exit; + if (ey1 > y2) and (ey2 > y2) then + exit; + if (ex1 < x1) and (ex2 < x1) then + exit; + if (ex1 > x2) and (ex2 > x2) then + exit; + + DoesEntityOverlap := true; +end; + +function IsEntityPositionValid(const entity : Entity) : boolean; +{ returns true if the given entity is currently located in a position + that is "valid", meaning completely free of collisions with anything. } +begin + IsEntityPositionValid := true; + + with entity.position do begin + { any collision with the map? either collidable tiles or fruit ... } + if IsMapCollision(FixToInt(x), FixToInt(y)) then + IsEntityPositionValid := false + + else begin + { TODO: this seems a bit clumsy ...? } + + { make sure we don't compare against ourself. since this function + operates on generic Entity's, we kinda have to check this way } + if @entity = @player1.entity then begin + IsEntityPositionValid := (not DoEntitiesOverlap(entity, + player2.entity)); + end else begin + IsEntityPositionValid := (not DoEntitiesOverlap(entity, + player1.entity)); + end; + end; + + end; +end; + +function MoveEntity(var entity : Entity) : boolean; +{ updates the entity's X and Y position based on their current movement + velocity and any force velocity. checks for map collisions and prevents + movement along the X and/or Y axis if any collisions are found. returns + true if the entity collided against something. } +const + { number of movement+collision sub-steps to divide this movement into } + NUM_STEPS = 2; + + { reciprocal (also as fixed point) just so that we can use Vec2FP_Scale } + STEP_SCALE = trunc((1 / NUM_STEPS) * FP_FLOAT_SHIFT); +var + stepVelocity : Vec2FP; + i : integer; +begin + MoveEntity := false; + + with entity do begin + { calculate the sub-step velocity for the below loop ... } + Vec2FP_Add(stepVelocity, velocity, force); + if (stepVelocity.x = 0) and (stepVelocity.y = 0) then exit; + + { if this entity skips collision checks, just move it and return } + if noCollision then begin + Vec2FP_AddTo(position, stepVelocity); + exit; + end; + + { we're dividing the movement and collision checks into sub-steps! + this is a possibly-hacky solution to fix issues with any frame-timings + that might result in us (without using sub-steps) moving entities + more than 1 pixel per loop. this could cause problems! e.g. the player + might not be able to move into a 1-tile-wide gap because their + movement keeps skipping over 1 pixel too much ... } + Vec2FP_ScaleThis(stepVelocity, STEP_SCALE); + for i := 1 to NUM_STEPS do begin + { add velocity X to player's position, then test for collisions using + this new position. if a collision occurs, we cannot move the player + in the X direction by this amount, so we back it out } + inc(position.x, stepVelocity.x); + if not IsEntityPositionValid(entity) then begin + MoveEntity := true; + dec(position.x, stepVelocity.x); + end; + + { same thing for the velocity Y now. note that, if no collision occured + in the X direction, the position that is tested for here will also + include the velocity X component ... } + inc(position.y, stepVelocity.y); + if not IsEntityPositionValid(entity) then begin + MoveEntity := true; + dec(position.y, stepVelocity.y); + end; + end; + end; +end; + +function IsEntityStopped(const entity : Entity) : boolean; +{ returns true if the entity's movement velocity is slow enough that they + could be considered stopped. this does not take into account the entity's + force velocity } +const + THRESHOLD = trunc(0.05 * FP_FLOAT_SHIFT); +begin + with entity.velocity do begin + IsEntityStopped := (abs(x) < THRESHOLD) and (abs(y) < THRESHOLD); + end; +end; + +procedure UpdateEntity(var entity : Entity); +{ updates general entity state. this includes applying velocity/force + vectors to the entity's position and also applying friction to those + velocity/force vecotrs too } +begin + { move entity in the direction of their velocity and any combined force + that is currently being applied to them. also handles collision. } + MoveEntity(entity); + + with entity do begin + { slow both the velocity and force down by friction } + { TODO: probably for the force vector, we should use something other + than friction ... ? some per-force specific value maybe? } + Vec2FP_ScaleThis(velocity, ENTITY_FRICTION); + Vec2FP_ScaleThis(force, FORCE_FRICTION); + end; +end; + +{ ------------------------------------------------------------------------ } + +procedure SetPlayerState(var player : Player; state : PlayerState); +{ switches the player state to the one specified, also resetting the + player's current animation state } +begin + if state = player.state then exit; + player.state := state; + ResetAnimationState(player.entity.animation); +end; + +procedure GetThumbTackPointCoords(const player : Player; + var out_x, out_y : integer); +{ computes the pixel coordinate of where the player's thumb tack's point + should be (assuming they are currently stabbing). } +var + dir : Direction; +begin + { lol, perhaps just computing, say, 8-16 pixels out in a line directly + centered on the player and outward in their facing direction and using + that as the point coordinate would be best ... ? + this all seems silly now that i've written it ... } + with player.entity do begin + dir := direction; + with position do begin + out_x := FixToInt(x) + + thumbTackRenderOffsetsX[ord(dir)] + + thumbTackPointOffsetsX[ord(dir)]; + out_y := FixToInt(y) + + thumbTackRenderOffsetsY[ord(dir)] + + thumbTackPointOffsetsY[ord(dir)]; + end; + end; +end; + +procedure GetThumbTackRenderCoords(const player : Player; + var out_x, out_y : integer); +{ computes the pixel coordinate of where the player's thumb tack sprite + should be (assuming they are currently stabbing). } +var + dir : Direction; +begin + with player.entity do begin + dir := direction; + with position do begin + out_x := FixToInt(x) + thumbTackRenderOffsetsX[ord(dir)]; + out_y := FixToInt(y) + thumbTackRenderOffsetsY[ord(dir)]; + end; + end; +end; + +procedure UpdatePlayer(var player : Player); +{ updates player (and general entity) state. this includes entity + movement, as well as player animation state } +var + animation : ^AnimationDesc; + i : integer; + px, py : integer; + dir : Direction; +begin + with player do begin + { do general entity updates first ... this will handle movement via + any velocity/force vectors } + UpdateEntity(entity); + + if state = Stabbing then begin + + if (entity.animation.frameIndex = 0) + and (entity.animation.time = 0) + and (not entity.animation.complete) then begin + { only for the very first frame of the stabbing animation, + check for any fruit that collide with the thumb tack's pointy + end and should be popped } + dir := entity.direction; + with entity.position do begin + GetThumbTackPointCoords(player, px, py); + DoThumbTackStabAt(px, py, @player); + end; + end; + + if entity.animation.complete then begin + { keep player in the stabbing state until that animation has + completed. } + SetPlayerState(player, Idle); + + stabCooldown := STAB_COOLDOWN; + + { stab/attack cooldown time quadrupled when afflicted by either + the 'stabbed' or 'splashed' cooldown } + if (stabbedDebuffTime > 0) or (splashedDebuffTime > 0) then + stabCooldown := stabCooldown * 4; + end; + + end else if (state <> Victory) and (state <> Defeat) then begin + { set player idle/walking based on their velocity. + note that this check ignores their force velocity! } + if IsEntityStopped(entity) then + SetPlayerState(player, Idle) + else + SetPlayerState(player, Walking); + end; + + + + UpdateAnimation(entity, playerAnimations[ord(state)]); + + + { update cooldowns / debuff timers } + + if stabCooldown > 0 then + if stabCooldown > frameTicks then + dec(stabCooldown, frameTicks) + else + stabCooldown := 0; + + if stabbedDebuffTime > 0 then + if stabbedDebuffTime > frameTicks then + dec(stabbedDebuffTime, frameTicks) + else + stabbedDebuffTime := 0; + + if splashedDebuffTime > 0 then + if splashedDebuffTime > frameTicks then + dec(splashedDebuffTime, frameTicks) + else + splashedDebuffTime := 0; + + if (stabbedDebuffTime > 0) or (splashedDebuffTime > 0) then + skipRenderFlag := not skipRenderFlag; + end; +end; + +procedure InitPlayer(var player : Player; x, y : integer; fruit: FruitKind); +begin + MemFill(@player, 0, SizeOf(Player)); + player.entity.position.x := IntToFix(x); + player.entity.position.y := IntToFix(y); + player.entity.direction := South; + player.fruitPref := fruit; + + case fruit of + Tomato: tomatoPlayer := @player; + Grapes: grapesPlayer := @player; + end; + + SetPlayerState(player, Idle); +end; + +procedure MovePlayer(var player : Player; dir : Direction); +{ sets the given player in motion in the given direction. this function + does not actually adjust the players position in any way. it only sets + their velocity } +var + speed : fixed; +begin + with player do begin + if stabCooldown > 0 then exit; + if (state <> Idle) and (state <> Walking) then exit; + + { movement speed is halved when afflicted by 'splashed' } + if splashedDebuffTime > 0 then + speed := FixMul(PLAYER_WALK_SPEED, FP_0_5) + { movement speed is cut by 30% when afflicted by 'stabbed' } + else if stabbedDebuffTime > 0 then + speed := FixMul(PLAYER_WALK_SPEED, FP_0_7) + else + speed := PLAYER_WALK_SPEED; + + case dir of + North: begin + with entity do begin + dec(velocity.y, speed); + direction := North; + end; + end; + South: begin + with entity do begin + inc(velocity.Y, speed); + direction := South; + end; + end; + West: begin + with entity do begin + dec(velocity.x, speed); + direction := West; + end; + end; + East: begin + with entity do begin + inc(velocity.x, speed); + direction := East; + end; + end; + end; + end; +end; + +procedure StabPlayer(var player : Player); +{ switches the player into the 'stabbing' state, which will start the + animation as well as bring out the player's thumb tack (during the + next player update anyway) } +begin + with player do begin + if stabCooldown > 0 then exit; + if (state <> Idle) and (state <> Walking) then exit; + + SetPlayerState(player, Stabbing); + end; +end; + +procedure DoThumbTackStabAt(px, py : integer; player : PPlayer); +{ determines what, if anything, a thumb tack stab with the pixel coordinates + of the point provided, collided with and what should happen. the player + passed should be the player who owns the thumb tack. } +var + otherPlayer : PPlayer; + dir : Direction; +begin + { always pop any fruit / destroy any plants at this position } + PopFruitAt(px, py, player); + + + { did we also hit the other player? } + + { determine which player is which ... } + if player = @player1 then + otherPlayer := @player2 + else + otherPlayer := @player1; + + { now check if this thumb tack point collided with that other player } + if DoesEntityOverlap(otherPlayer^.entity, + px - PRICK_RADIUS, + py - PRICK_RADIUS, + px + PRICK_RADIUS, + py + PRICK_RADIUS) then begin + { we hit the other player. push the other player in the direction + that this player is facing } + + dir := player^.entity.direction; + + with otherPlayer^.entity do begin + case dir of + North: AngleToVec2DFP(BIN_ANGLE_270, force); + South: AngleToVec2DFP(BIN_ANGLE_90, force); + West: AngleToVec2DFP(BIN_ANGLE_180, force); + East: AngleToVec2DFP(0, force); + end; + Vec2FP_ScaleThis(force, PLAYER_TACK_PUSH_FORCE); + end; + + { also apply the 'stabbed' debuff to the other player } + otherPlayer^.stabbedDebuffTime := STABBED_DEBUFF_TIME; + + { finally, spawn a 'ow' particle as another indication that a player + was stabbed } + with otherPlayer^.entity.position do begin + SpawnOw(FixToInt(x), FixToInt(y)); + end; + + end; +end; + +{ ------------------------------------------------------------------------ } + +procedure SetFruitState(var fruit : Fruit; state : FruitState); +begin + if state = fruit.state then exit; + fruit.state := state; + fruit.counter := 0; + fruit.value := 0; + ResetAnimationState(fruit.entity.animation); +end; + +function GetPlantRandomLifeTime : word; +const + MINIMUM_TIME = 3000; + STEP_SIZE = 2000; +begin + GetPlantRandomLifeTime := MINIMUM_TIME + + ((1+random(5)) * STEP_SIZE) + - random(STEP_SIZE); +end; + +function SpawnRandomFruit : integer; +{ spawns a new fruit (starting it off as a plant) in any random available + dirt tile on the map. spawning may fail (if a free dirt tile could not + be found randomly). returns the dirtTiles index of the new fruit, or + -1 if spawning failed } +var + idx : integer; +begin + SpawnRandomFruit := -1; + + { find a random spot to spawn a new fruit in } + idx := GetRandomUnusedDirtTileIndex; + if idx = -1 then exit; + + SpawnRandomFruit := idx; + + with dirtTiles[idx] do begin + { important! this marks the dirt tile as being 'used' } + hasFruit := true; + inc(numActiveDirtTiles); + + { zero out the fruit, and then fill in its starter properties } + + MemFill(@fruit, 0, SizeOf(fruit)); + + SetFruitState(fruit, Plant); + + if random(2) = 0 then + fruit.kind := Tomato + else + fruit.kind := Grapes; + + fruit.value := GetPlantRandomLifeTime; + + fruit.isGold := (random(100) < GOLD_FRUIT_SPAWN_CHANCE); + + fruit.entity.position.x := IntToFix(x*16); + fruit.entity.position.y := IntToFix(y*16); + end; +end; + +procedure PopFruitIn(var tile : DirtTile; player : PPlayer); +{ switches any fruit entity located within the given dirt tile into the + 'popped' state, as well as starting up any relevant animations. if + there is no fruit in this tile, or the fruit is not in the 'grown' + state yet, nothing happens. the player passed in here will be the one + given 'credit' for popping the fruit (or if nil, no credit is given to + any player). } +var + fx, fy : integer; +begin + with tile do begin + if not hasFruit then exit; + + case fruit.state of + Plant, Growing: begin + { no score credit for stabbing a fruit plant, or a growing + but not yet full grown fruit. just despawn it. } + hasFruit := false; + dec(numActiveDirtTiles); + + with fruit.entity.position do begin + SpawnPlantSplash(FixToInt(x), FixToInt(y)); + end; + end; + + Grown: begin + { stabbing fully grown fruit } + SetFruitState(fruit, Popped); + with fruit.entity.position do begin + fx := FixToInt(x); + fy := FixToInt(y); + + { if the stabbing player's fruit choice matches the popped + fruit, then give the player score credit } + if fruit.kind = player^.fruitPref then begin + SpawnScoreUp(fx, fy, fruit.kind); + inc(player^.score); + end; + + if fruit.isGold then + PopAllFruit(fruit.kind, player); + + SpawnStabFlash(fx, fy); + end; + end; + end; + end; +end; + +procedure PopAllFruit(kind : FruitKind; player : PPlayer); +var + idx : integer; +begin + for idx := 0 to numDirtTiles-1 do begin + with dirtTiles[idx] do begin + if not hasFruit then continue; + + if (fruit.kind = kind) and (fruit.state = Grown) then begin + PopFruitIn(dirtTiles[idx], player); + end; + end; + end; +end; + +procedure PopFruitAt(x, y : integer; player : PPlayer); +{ switches any fruit located near the given x/y coordinates into the + 'popped' state, assuming that the fruit are already in the 'grown' + state (otherwise, they will not be changed). these x/y coordinates + would normally be the pixel coordinates corresponding to a player's + thumb tack point. the player passed in here will be the one given + 'credit' for popping the fruit (or if nil, no credit is given to + any player). } +var + left, right, top, bottom : integer; + cx, cy : integer; + dirtTile : PDirtTile; +begin + { get the map tile x/y region to check for dirt tiles within } + left := (x - PRICK_RADIUS) div TILE_SIZE; + right := (x + PRICK_RADIUS) div TILE_SIZE; + top := (y - PRICK_RADIUS) div TILE_SIZE; + bottom := (y + PRICK_RADIUS) div TILE_SIZE; + + if left < 0 then left := 0; + if right > MAP_RIGHT then right := MAP_RIGHT; + if top < 0 then top := 0; + if bottom > MAP_BOTTOM then bottom := MAP_BOTTOM; + + { for all dirt tiles located within this region, pop the fruit + in them } + for cy := top to bottom do begin + for cx := left to right do begin + dirtTile := dirtTileMapping[(cy * SCREEN_MAP_WIDTH) + cx]; + if dirtTile <> nil then begin + PopFruitIn(dirtTile^, player); + end; + end; + end; +end; + +procedure UpdateAllFruit; +{ updates the state of all fruit currently active within dirtTiles } +const + GROW_STEP_TIME = 40; + SPRITE_MAX_SIZE = 16; +var + i, fx, fy : integer; +begin + { periodically spawn more fruit } + if (fruitSpawnTimer >= 1000) + and (numActiveDirtTiles < map.header.maxFruit) then begin + SpawnRandomFruit; + fruitSpawnTimer := 0; + end; + + for i := 0 to numDirtTiles-1 do begin + with dirtTiles[i] do begin + if not hasFruit then continue; + + case fruit.state of + Plant: begin + { count time into the plant has been a plant for 'value' time + at which point it should 'grow' into a fruit } + with fruit do begin + inc(counter, frameTicks); + if counter >= value then begin + SetFruitState(fruit, Growing); + value := 2; + end; + end; + end; + + Growing: begin + { the fruit "grows" by scaling it's size up from zero to it's + normal pixel sprite size. the size increments by 1 every + so often } + with fruit do begin + if value < SPRITE_MAX_SIZE then begin + inc(counter, frameTicks); + if counter >= GROW_STEP_TIME then begin + inc(value); + counter := 0; + end; + end else begin + SetFruitState(fruit, Grown); + end; + end; + end; + + Grown: begin + end; + + Popped: begin + { when the popped "animation" (not really an animation, just + abusing a 1-frame sequence with long delay as a timer) + completes, we can deactivate this dirt tile and fruit } + if fruit.entity.animation.complete then begin + hasFruit := false; + dec(numActiveDirtTiles); + + with fruit.entity.position do begin + fx := FixToInt(x); + fy := FixToInt(y); + end; + + if fruit.kind = Tomato then begin + SpawnTomatoSplash(fx, fy); + + { if the grapes-preference player is nearby this tomato + splash, then spawn an extra tomato splash at their exact + position and afflict them with the 'splashed' debuff } + with grapesPlayer^ do begin + if DoesEntityOverlap(entity, + fx-32, + fy-32, + fx+48, + fy+48) then begin + with entity.position do + SpawnTomatoSplash(FixToInt(x), FixToInt(y)); + splashedDebuffTime := SPLASHED_DEBUFF_TIME; + end; + end; + + end else begin + SpawnGrapesSplash(fx, fy); + + { if the tomato-preference player is nearby this grapes + splash, then spawn an extra grapes splash at their exact + position and afflict them with the 'splashed' debuff } + with tomatoPlayer^ do begin + if DoesEntityOverlap(entity, + fx-32, + fy-32, + fx+48, + fy+48) then begin + with entity.position do + SpawnGrapesSplash(FixToInt(x), FixToInt(y)); + splashedDebuffTime := SPLASHED_DEBUFF_TIME; + end; + end; + end; + + continue; + end; + end; + end; + + with fruit do begin + UpdateAnimation(entity, fruitAnimations[ord(state)]); + end; + end; + end; +end; + +{ ------------------------------------------------------------------------ } + +function GetUnusedParticleIndex : integer; +{ returns the index of the next unused/inactive particle. returns -1 if + there is no free index } +var + i : integer; +begin + GetUnusedParticleIndex := -1; + + for i := 0 to MAX_PARTICLES-1 do begin + if not particles[i].active then begin + GetUnusedParticleIndex := i; + exit; + end; + end; +end; + +function InitNewParticle(x, y : integer) : integer; +var + i : integer; +begin + InitNewParticle := -1; + + i := GetUnusedParticleIndex; + if i = -1 then exit; + + MemFill(@particles[i], 0, SizeOf(Particle)); + with particles[i] do begin + active := true; + with entity do begin + noCollision := true; + position.x := IntToFix(x); + position.y := IntToFix(y); + end; + end; + + InitNewParticle := i; +end; + +function SpawnTomatoSplash(x, y : integer) : integer; +{ spawns a new 'tomato splash' particle at the given coordinates. + returns the index of the spawned particle if successful, or -1 if there + was no free particle index } +var + i : integer; +begin + SpawnTomatoSplash := -1; + + i := InitNewParticle(x, y); + if i = -1 then exit; + + with particles[i] do begin + animation := @tomatoSplashAnimation; + end; + + SpawnTomatoSplash := i; +end; + +function SpawnGrapesSplash(x, y : integer) : integer; +{ spawns a new 'grapes splash' particle at the given coordinates. + returns the index of the spawned particle if successful, or -1 if there + was no free particle index } +var + i : integer; +begin + SpawnGrapesSplash := -1; + + i := InitNewParticle(x, y); + if i = -1 then exit; + + with particles[i] do begin + animation := @grapesSplashAnimation; + end; + + SpawnGrapesSplash := i; +end; + +function SpawnPlantSplash(x, y : integer) : integer; +{ spawns a new 'plant splash' (for when a plant is destroyed) particle at + the given coordinates. returns the index of the spawned particle if + successful, or -1 if there was no free particle index } +var + i : integer; +begin + SpawnPlantSplash := -1; + + i := InitNewParticle(x, y); + if i = -1 then exit; + + with particles[i] do begin + animation := @plantDestroyAnimation; + end; + + SpawnPlantSplash := i; +end; + +function SpawnStabFlash(x, y : integer) : integer; +{ spawns a new 'stab flash' particle at the given coordinates. + returns the index of the spawned particle if successful, or -1 if there + was no free particle index } +var + i : integer; +begin + SpawnStabFlash := -1; + + i := InitNewParticle(x, y); + if i = -1 then exit; + + with particles[i] do begin + animation := @stabFlashAnimation; + end; + + SpawnStabFlash := i; +end; + +function SpawnScoreUp(x, y : integer; kind : FruitKind) : integer; +{ spawns a new '+1' score particle at the given coordinates, for the + specified fruit (affects how it is displayed). + returns the index of the spawned particle if successful, or -1 if there + was no free particle index } +var + i : integer; +begin + SpawnScoreUp := -1; + + i := InitNewParticle(x, y); + if i = -1 then exit; + + with particles[i] do begin + if kind = Tomato then + animation := @tomatoScoreUpAnimation + else + animation := @grapesScoreUpAnimation; + + with entity do begin + velocity.y := SCORE_UP_PARTICLE_SPEED; + end; + end; + + SpawnScoreUp := i; +end; + +function SpawnOw(x, y : integer) : integer; +{ spawns a new 'ow' particle (to indicate a player was stabbed) at the given + coordinates. + returns the index of the spawned particle if successful, or -1 if there + was no free particle index } +var + i : integer; +begin + SpawnOw := -1; + + i := InitNewParticle(x, y); + if i = -1 then exit; + + with particles[i] do begin + animation := @owAnimation; + + with entity do begin + velocity.y := OW_PARTICLE_SPEED; + end; + end; + + SpawnOw := i; +end; + +procedure UpdateAllParticles; +var + i : word; +begin + for i := 0 to MAX_PARTICLES-1 do begin + with particles[i] do begin + if not active then continue; + + MoveEntity(entity); + + if animation <> nil then begin + { particle is a "sprite-animated" particle type. + this means its lifetime is tied to the animation. update it's + animation, and when it is complete, kill the particle } + if entity.animation.complete then + active := false + else + UpdateAnimation(entity, animation^); + + end else begin + { TODO: "pixel" particle types ... } + + end; + end; + end; +end; + +end. + + diff --git a/FRUITPOP.EXE b/FRUITPOP.EXE new file mode 100644 index 0000000000000000000000000000000000000000..f701eac3c6dd44dc1c64b9d363d8d69b8e0b1822 GIT binary patch literal 95543 zcmcG14M0>?+W)!paTx|2Q2hSD@ryLd@3aJoR3_W}AX79mKR{?iLl00S*BbzzN_Jz@?ePUIh*TM}aEf3~&*+1~db= z0hM+R3j>A%BY=rOEU*w*3v30R1O6K*18RYAaSrPTB(T@mLSQwJ4&(v!UpX*Zc#Ta1 zOu!R>1+W3n1Fr#s>NVCE7z4}%mH?{&3$Pp51N;go0uBOy0!n~tpa%E~Xaz#mud&`h zII9C+*0E8*oxp=YI;zr}4gqCAEpP?+4hRzN5EcTf zfNWq7a2B`%v;%!rcL;+3BXBnm1H=Q50xN)xz;3_=d<@hA<5`jr1H=OhfyKbjfqlRq zfGXf4paU=nNx~%HAz&4-0muakftP_{sw81Luol<>JPYgx4ghZf9{|UJI^YV>0)(rP zC$JXS1^hSgD)2K_C_D~i09$|qz=yy$Kp&Ji16T#D1GWPDfVY53-~#Xs& z0SpB01f~HG0c(Ms!0W&Vz;Pgml?%OrWxz(@GaynZ7iI#_0%w8iz`d$+(6Lnl;52X(5Vhrk5x56f0;B=EfwzEC;1Zw}%Y^~Jbl@RiJ@8B56`%re z18smhs9YEU+zH$Rm;ft~2mBg%9rzRQA@B)s0r)2nq$?MW04%s%hz2r%{lL4xS)c*v zt1lPs0v-UC0SiLV&QRp7+NIK|cc~@;vw;N7F4Z#NrnpNrJ{a%73Lq1B2Jiww`dzBA zz)D~vun))$+oc-KURO^AtUwX)4KPS}UA+f50Q?E40zL<>174ty>UH%PU=FYrcm{YC zs06M68ujby(ZC$wF<=+)0`LY<3Y-Qm1K$Ecn%C9+fxCbh;1OUouo>6^ya!YP9|7lq zFM$qVl=gLXEU+9{1z3QsK&`+umw%$9U_DR*+|Bgb z`9LOc9=HtD14cow4N>W};lKc3G`mat7El8GL%2(OLUot62KXD$TYZ=IVW6C?(GF%i zw2uQ$V56`@`zi2G;3m*VwL|+buo7?qZv(T{JG6tu9opic9oj$Wc4*sx^}#!|nPEG$ zJApFbEMN%Vp&bG2?7c%<2)qcq1{?%F2QC7v&kn5?hytR4Sl|I533wcM2lz8^47kAl zC|&}33x5>*18aeGz_Y*$Ks|5+_zvjDJ`pp3EZ}KCVAsSU!ZopY;x*AT`I>kx=9>5| z5EOe&i~^uZv3{mCmNgrUshOD@Gshbfwyd+P%Xo5p(CjtVtkfCC6HH(QXP>JmxX`}m z81sIZt$Fi}y%WE=`Ra2QT%$onS3A1EbrZC8^#b8azj!`!X(^PPrRmJIa@sY~_0c`o zL_1Ql>``)H|IR?lv45ACB?5ExM}Na6JP4EB!sX4%l)XQ^rN4c#RbaZnL7is zxJp@sdrGy!Ppd^g#B(voP+gf-S2`ST?lT>w5B$W`k5KAlNJXA{1*QH~hifoIztZZ` z9g(PArD2EmWW^|SzHyE5!8wbJQ@7wh<81Sq4I5H3o=i0+WLPq{5_629I4PN_Yb;=m zwW(Q~)>%@GPgzsU#;gr%Qq~h2A;uENKYi5Z1Y{b}S0=M70fn2J1Xmv9N%~}>dFd-E z)RJiKnn-~)K|GLG(;rjmBsoFVPfl>M0>s1cn5)Il5)4&W4aTo)KL)%j1`^8Eh-$ck zA>{h!D(7@9}FuLFCaF6j;iOI>#9+#XfT7GsQIXRYDgIpa@ zL8KY6n5JE?LgSGp#H!#N4dqK39jk^@gkCNUiq%*{k#`+)Jp=ty3XauUwXT<-CQE

hR zpRCX?ob|JW*^3`aO3>f8B#ZiJ>qcv)(PFkfm25$;-DTXgag*_>jhU&&v`p(d3qsap z=y{xtn>KCCNX@W}*Dpy}gI?aWVa?XmOk;|9_@_4;|kg?m} z;*E&2F-xx>*e$^LAY?=;0v=nCy4hEW4Qr?bUhbMrn^M&zZGzKF)-QYS!zJBg6HIZ+a>}wBjp9^ri$$d$VqrzBCKfvAQLo7YpJ8j@S-f8{s z;T>*1!F@{L^RD7^h?#dW@3f)t8tjk6y>ws{QD&6VA(X393oE%-`${nX0jb9#b(Eai z^=Hh*>4Iw@9w#eiKeo|oG_T1{HTua1!TeOJG1HonW!z{5%WULKv?fc>rGd;xYqE&b zj45j}K+7c$rSZ2lL}Kt!mKh=htN=za5}Rd_DBQ zHZ?;ohbo0`e6_u^8#_B}J7kQHROJEg0qRcw$(?SqotX z$@-BGOn7v{oC!<2rCA&hd0}E^YF3sp;nCT=qe$lfVb)FnL6BoAlo3v#jcFLV#x*IH zb?9k6GL6cZpiZI=&oriHtj!_;?|$lbC)xNM$GQJ3k>q>af02CcGH1IxiB=k}>GU5= zZiP2zcDlPV;t5!9z?C$SPbw?UX722EK50O%uF>YjWi$0Qb^RsgT8dX)nMGay4s&gU z+hJ;VBze5q_`f}UDC8;+)_BEirg+}hlc&&==Um0p+FMEburF4)*O1Mq7Hqp*Jtab7 z_Z0JeDSA^4D1~a9SPiF&)z9)4WwV)#S+(x{x1~Na1#%^INV=ISW>vfMJoWv(@_a$_ zIG>MBegsv}$3e!W>oT%N_+BT=uOSav?#MDeU|hT|b%f3r)909s?kovsu8Ei=^R9>c z6ryCBW=bGE-c_WBe{d8XNRAOtC1(##-;y4S37iyBK7m)6z7?uW4NQtHI)x|)I-`UI zL}7>`NQ2Bf7*dCqMs^Fr^!oE;W*t&;Y+Av2x#Ox$ZDZM_GKZ?+C_PyOrMjUj3(Uat3>+T z^rxM+w(_r4-XjpXM--6@MFrli-Mu^IK4>!O%%a3}^&VRzbW63XR~(dy)#hhdzNsaV zd%Ciq}q1_s1u4LU?Xa1P+=1uW6&s@WLY@gZ9{eP^1r+R20l6|j* zT}LeOmgwUxQ5n1Lf{xB%TV?VxyUok23CggwPFKckn4qrCti_7cHGW=}d9E+0ox) zE^0SB@p#Xzo^-*r=3XrFWdG7F$fxLu>E)L+iAAgU* zf~H2&dOm4V^HVdd)S~o_G)Vt~L3&it1?QzNH~)^M-`kTaSZ!)wfw9uI79wX0B+MX` zWRPj;owgd&)Jl1pk~9biLv^&_OsivwPE(s!!xB-a#L~k)PV!~8g=Z%GN12uRGV97S zyk&kVzlFIYyj;LnnLOYW5B3S_3j<`l-6!LF;+J5|6I;;p9v{>Ags~;uD=Kxjk+j}| znSisJPrh4vdkt~~wjIKG3zq0T@SR7fw|L!|p88Z-DidX4+_ehvyG>r|#frkw57GZu zRPiUm8JA)n5@qdNo`Dx2w@|-kRwb$!@!YmHxI%{$cyus*|y-Eu)Mf-Gt1JUvhC(#kJ%o# z6eWc6T0;Ci9<)nkk9(}sOQm=%?(`BAuN9qMOz}#9mtJo1IvwS7Cyzq|%b)pOonF4o zhjn`SGLP=`@?~y>mtH0!WiA)9UaJgT7r9))z3{WYH-7$|4)B^hdA2r|6TEG3uC3Lr z&Wv!HJW5~lUT;N*a{@a|jgF+I)6-3jr(=IT{%O_e8K0lN&(?5yW`5eYzsb}F4hSE` zLpa4ZqsLl=`q3V~K(^bOnI(v80g{#;T2cn^ht)gQXrxC&$ClSX#;nv0sZj1VX3!$N zzr3C?LrG6gg-VPyT~=yF58A;A9XFovrROjbH-{i@{?J_~$cuZLd98iYrt8TRquO>LYM0ObVWg)_W!La_?z2Vhn}0;LoI%2IuB&4lNAASwi<>^uh-qj z({)~!B`)UXt-iT={g2GeI-0oxM6G{*o+@|xI2c!U!ya1vH0F$_F#&~EiRhUsF*8|^ z^yG&8gL=g0A3-W`=XFTAo%1<~eru4NRUpf2h~-c04zQqlJRfH3{1#NyitRaO^YmZ3 z=a>h-E+;IevIpd06`4=J(OeUQ%Pjq6U)O`v6+g$WZ63+$OS}b%)76v85))l-BZmFh z7SDXE!G3J3=K*Vw{n*o8TSI}VQJ$n>5KA{!+L{zKpOhIzlfffBtkTwi5HdOjgoKl-L-DZN zaW{WyBMr#N=*6`GI}=?a^K5dfdod*|*XM|W1&0w05-{x!^8Vm>!>nnGbWilSkNv=i zL-OhX9p}i8={ViTonM2&g47n77iWu<7o@gGMS=0_KqI~A0Y7PrY>_f)LqOUfc+W*8 zyX!pT^5V8dvg|?Yk*&fvT>#nTKYfwHVXj>iYY=?k_v)Ck8B6x%L(~c2&xB#k904 z9TECaMwTVh$|tET%_A^IMsR!dvZ>2pkDmL$ym<)=9!%&v>#-Te2NM=0%rQRv(1Hi= zGESa2c@h_9ikWyIG2-vQh_5MH@tpJwa|uhI+c|S|t_i`LYl$~W*Rx0dXIim;1?lf24W$A$MD^z=BT{wquAykJjSqWJtSn5efu5EsyW0Y)gfWG={tDk zRu6)-qp6mz=G&Uprrzmx35CsgFYy z_7@HZ3NWhBum3=vdu(l(plz*~zk;EFV{sx_Q?c~-X16+R?cEJ8cH4K%I){q#T2)cr zd(xJrmAk`174i@PjpF04!_K)WYD_xcvv5c$|L^kp!Rkss`+rx+$x|A3q7P$5E0gDf zc_x*`n3}V(A{Km%vfk#oJGc6sm`F^BjRmGAP&o>w!}?UA($?s(-6$~myYWV6H*QKH zeM0F(^im@QVSg)DPSKstH@eZehd!!rVzD$0I>2y^sKgjyurCa1~r!8lol# zI%|R^w)D`%fZ6&#ZDK}GO^inqGeF~|M}%Mu7Z3^))umMNX*dnqJSOQ7|ZM?c{>|K3^#TdthA6`jqwNVUh- z1TIo>yS?mIHlu=q{2NoS?dY>YOM^Ro$Tl73+C!VYA%VWFitovfU;wwrVd}ML4DR4o zdmNaWoX^mBTT8pEd`ixfW(^&P;i>0N{Xph4g<|Qk|2-WfBSd{3j6Jlo1gF!a z4+v?>vo$FpO-@r2riDhD78-L_Ly(f>K{K1-+d#ezIkP|+@+Glbeo5`Dahk%h>QNtu za?z@I7-SEcq+!+p!ntyR6v)9^fr!Z8`diAkv$$2hDF|KS&p4bi_GTO8toYolWYsN> z(_~PiSy-RRQ6o|6P+wFk?KNs!52bmt!#fK!V9AC8vDTn%dSHK4EDE>Zg< zYTquUAzOd7X&&OzotMSyi8Y~I$Y7)#sEB@E2txb`^$65;3sf5F&tN3t7v&O4D3?&jM2I&iW-xAhmN{#t zlr2K-LKRoqnAK<*(|FD$zqrb~{b%QQCJ z)Z#q}8axW1NL+CwT_x{p^mE-|x`Cks9;&0EP-j!uf5053FK9G;K@l1-bTH}=;T%Oc zmy_x+U8K;9-fUPF8f2|4E@neP7SZpVv8Zlk$_DE{HnRKh>fC3o6cctD=@X^o5Yu*T2lKt zYbtG_U<{%5Ql+g8^>=F3$Ki@nCq&3H_2enNlB=Gyeuu5Sz~tc?%cHPhM+pgPBv(_J zF$spu`(dS&izFXsLg-w0AVjc6l81eJA7%|EuPUt|kwdPf6hwaB1mWZ<9Xruq-lMCu z=^eIf1*Yp57o7@Vd^}%0T!UwTf=|AXW9`~7Mxp_Nu1#?^qud|Jrm51_LpJD*CM9iy z)6}Rq!7mVbjobAQb@Wt8Gq}$Uo9uJLrjo{@0x_m0iUYCOggE`VPXon)PXprcMI#yY zsG$a5Lk)_G-a|the{w^4ee_BV_5K=)N)1JS4MUY0hWcx$Q);N|Qo~T+b}3d2pds;1 zm#%=|YwKFOL>L{J21hPLvbIVOmTXBbI8UR5GH5M09&^?@B&OUtKwQfAT@0`^>&krF zWYR#yLI`cC8r-cNogtiFSngoaO8N5Ikd1GTt+_v~LUXHi@^Un{Ivfs{QK;9TpF&Kn z)(}u7#MF*;&&xl$?(?$(ig3a4DXA+ciBuLO8g{Y)BLMi&mDSR=;A;zF3 zA|`E>^?6?t`5+akK?=d0+9>A|Rq&auK`m!m>hjKe^V-<9pqx8qejJ)Lk~+YNY@AEP zZZSe~w1|=EU$yg1NLn(=0)krcN17Dm@hlS%6qquFQvjn;CM9|OiF=U z)p*C)k8)@$ZM3ur80LY|mUT;J=E+1PBVqV&*Wf3X2$K0q=*vZ|Y(gP=7I)e_p2j+3 zFtbj_V<@vu1lJ8>)^Rd9U_Sv9alM`Moxxq>fpr508iiLbfX#?e2QkY;?v>6AIPgQB z)d?dK8DGQr3^dTE8o&Z0$}g!P=tt1L1En>pE#v5+v5cguy^g_T>E+LCnnwzeUj&1D z9OW!7Mdbo4IR>{LYv~3QHG*Xir2=9^OLBHFiTrUW2BI5UB$X(~8YRaX6&Pz&XRJ|j zEG&^IuQ7qK#&pISQE4Exx&OC*Sq(X3OdYO=S*klw%1N zk2}m|^++$(QV$FzWi7@M7WQThbg52F ziB62#q~MJn2KSq-{5a2H^nfUjw%bT0%b$GHZICJ4%+$&(@hOgTOS3?p z2s6VB*Bs~_4a&e9Be9EjUl0W+~VX^V9wotLLg)x>lyf5xvXs|nJUge)g3 z8m*17M~5AJzVGJRgj-CYDJ;WYOpFJxz-&jP^|p4u!I1NKRYH{D6;~(op%%r58W@7! z+(}-nTdBO@GAnGvt>BsAOwuVX!M)x~PDjG1^tC+NOfAN6mJmYY)~nzLe^g1y@MPJU1L0yy&>$)f z3hr3);x^DQ9)c0z&4wMofI&ei4DMPD?e|h&$(CJc$T6n&oP{WuR1)-3r&(7v9+FvC zB}FNP%`oY$gK6}stP%dWOXb1lK1!T`?5ywdF^m~Z9#8w<3+J{41k-@>y}|}Y!_4;z z1)Ij1@0D-Z%7zFWcWIBX!En(Y0mDU`VuWbJo~@pITlFXhXI^9_`bN%5Z0Rcc6&UY2 zuhaD$sPN6?+q~Y?)K?A7i;VQnowM$BzA)!rT9eU2sUgJFXrW0@^tI_~2Up3jTR(*2 z9%H&;eVyypXj^Vvb}|m%^eI}6Q>c$m&k8oU+dxj7s**|DN~CSY;_sUtjpp34s_RGv#5kYM5$Ho_S^Nb0>q5E{vIJ#4W1m&i{=`Hx_*R!k>=xWQh~b&7S4#> zwmz^fqT=n_hcjy?I1HvLgZuY_Y+s}tNT#;mZRF?sIgn%tW-l%ZX|XS#y@d1|ZU5lY6lT@Q;!uKS-ag!V#V>q#0)zXw*C#qv z(&LnhoAT+X$7n7h{a!(|$PF;kS0zMZK`$yYuSt=482+6;K5<9ln99Y)JipXdhOi}| z_+g!8l`J+FoQJ?QLf087H-Ivr8P_NFl?E)6|>9lr*z zH-KoEQaei|EyeBW=xp=doh6oB2`I&v;geUtmmzuq3p-*qzYzED0P$tDyaNR5NgL%t zDtqs5<;9)69W(|5crcEAlVL}KTBby!D13X!;9h=1-qNui@SUaL_8>#I^H5@!^H9p^ z(mnh@lza>D7q}73<<0;cadPZxrt^xs+WBv*N78tAwQ_eGcei

nz-Ptla}qom;(Y z3Jz7*$UW~^ns%n;#~h74-S_p4QewzU@NTg}{jvNBxq+i=UVZ(s{CN%Z zd-)R%^?Uha8GT;VUs}czX%kKfRVEe}k%|YyPEEl|em<$+8IBpGYjWA@Yq-4K;13_$JzO@``@@y|JF71nr5}(<0(83 z3{L9dKRd{R10|o%Y4|KQs-Hf>$U^V(53n!kQbttiQEZgT-L6hok&pi*KNX$6E&Yzt zcl}YeA_{!`H*zS7`Bj!art}Se998B=8JnmM4SGm`Z$ z`VV&gq_dfilupAYGgjpx0-v$vJh>;l0#0Y<;&f(+fa96NB7rJ>fSG}7_^={^>cPo_RoS$Q7gOqHj(rsMzhQ<1N&Z9nse7&g=s&^B#ZKtil z{z2+=Qzk!FDBUOB0Ut#n57{~AUdsUaz4C)u_hNF2!sJAKE`@U~{JQlW*v?5C|CMi? z;H(O@oLlwj@JScVRk7-KJJ<0eR(+5RlZwLxWliJ`5k9chqapC&4r(F{3W`Bo^c%z* z6@z%A-yp724B|S!LA*&Zh&OdHh+|y_^F`^bdpY-PQgiMp#St4~rZ?pkGA0q_QU{S4 zOAOyG>v~fwNDHESoHkGX&eZAh-HWiySvcf0ZF4MY3&rAY$Ij1Vuvn6v7vSXUa>vfU z$B@^ao$tiJqHd%4)`6vw14|=Z93mdD{+gCsRwwkB;+4r*=B!SJqKo==Q*?2^Cz-Fw zQL**5w!7^g)WtCCTypx33z4~&o8e_c#U1FXanPa3hHd1A`!4>Y$shedP2)?w+ zaDz%8r&No7O%dQxlcLA(nUub)6lZg&OYIuDhv{q^WOo*SLz+*MtHn#n0wuqkTqRyj zrn@>{!?Qk_>LAHM-@xNv_(&SUzJ;?TS%a`!$%#1W-oaCN;ES(?v7(mbmZ)3F#kZ-~ zRH%=E*C#yX021`$)gJ(#DzR@0D>9_CM1`jm_enwAL5MpBA#mQ2QYA*G2-V_UARgYw zQ}{%L$I9Vx2%kmavr~FgctT34eAFv_g|Ahc5PKUhX9q>hOVLooXW{!i_uZdD?=H&t zH}HIedmc)mw!clDN8nk`J*!ht@rslNihm-dbg`L}ZvZc-T71&1r+~#~^rD#vzsyX% zxZF&%TVW}R0iOPMJpCKySfu|0(*F+W-!K=yX)Zn7HGQ?2 zGv{HXFXQQt!@yT1Rv}Fp(i}GzSDH&d?waOHb1;?pG1AoWH0ODmi%3(4H0RC5Uzkg; zbWPJ@j-oVIkfwpBX~fqqs>EibX+WArb8(Zo%X$J^aJaSTTwpkRX*aD=_0FVF2ohY; zgxGZ^>0rZgBw@nRU>80{Gk6KKAMUBXsER5Ffw4bYzA2Z<^H3-q|Gp=7PDx%TT^=p z`{}T9snDY*$YOQ^J-QG1%RNd_^AmIvuOPUJf~#`Y`E(2lvv1c6*1^~eq&=@w{b99h zb^Q)EVlZc@q$FuXmk|G@8sAkMT%^H?3nd}hu8`cl6&63}7FE`l!Dj;P`=c=@(3p*0 zu7c1WJ9b5IamK(-ECRQ7ZyB{^*B`KsjlnNkbBUiRz; zM_A?cQPJ8cwH6h?iFBIh!P-PN-vyN>+@jbf=4^;5&oZNm{2YicMs)d*vlt+`wuX3t zETnkIggABxSA%fEqz6hoAlGJ(FN$js$OwxlrvQGN>TNJ$C>7(LjnqES1s|*-)vOC$ z4&$Sp$87i_RHZE(OHt)A6n!D8>t(1Ra;!kTb`fRA>YrB2L3@s6QnJwRRasqszuNom z7O(f+Y_BU6m38dO_B!@$@#Y@0co)sLj?G0%(?Y8edbW4ge5)?^*wfyJ=2=G4`+TGP zo;b_WC!h)_SyhiMoUSo^+uXb6d6l^De|YyJ)5fi4fs4X#AJXi z`Vz}KhW1jIWO$kS`(5%Bt&Gq(zG;d*wjP=|8JdD)*J3XjSQdl2Ktt^%p#e#_z@K=f z+^vGh?-sDTUw5DU1mTC`E)l*TS@naFRk_C&d-;`;4PI$Ekzmea)5MaMRy z|L-B&orSNQ4?Ed%KOIIQAtoCrPsf-%bR(Iu(=$$6xeRF}1ml;=6WuZB|}O z<=4j3GvyNuE)71e%7@bkl;8Zp^!`aeQ?;_OaooXLilZfy^9~8Eux#R!*~H2UXshhK4f6t5&v> z*j6VBrrlY2zp-oJIs~rcfwCFCbDJB-v*^^DEWGJB4sFn?wNVk|@@2+DkrHQdcrct1 z=56_;`{742*;1z$y=GSA;0J20iE^nS?K=9 z*uL5kTfBR-XWxm5T_BJ2W z+;UmL8^xNvj{f4_L({I#&Nq3k#$!^x8jlpkdUo=-ibbX+mi%4+TwR)1)G++8y=g^2 zjHubWEi`RXSz0mM`?5DuxA&0osxfWZ@J~KEfvs+ueC%A^XRADW-A2p{UgN1ZZLe{NlePe0+aepBw9W=z>+HR6*`=5T35{@0Hb9O5jdto9`qb*WEfhB>fxr$6lTlPVQ(( znrp@cF{A-cCA#01gZu|8!B@1s=bFnu{)FVoRzP+?BC!YkuLxb}O zs-oxiVw9@+ew)H!@WRB8+u*$p?A<#$C-zROzXWO>JY#2ABZ~_5-V@J2h64qA6W#N@ zcs~};o~w!~9>8$6Bted0^v8(q8p9ZCvJRy@!u>IVyTst6LxeF#s!9kd)eG$Y++Hb| z>UY}vCyt4Y0 zy-2us?4KPe(gnn-ouPY~d!ZMviP*<}+9OR>LhK(P z#1g^-)b2GNX-Gg4!F|Z%9wes{+;cn#dgYgUsdXNz-IX<=cDanJYY;R#=js{~1}B4t zuUfhMvB#HvLcC;;!?IL4bNaA*d57EuMFWVaM4nBdaJUb9(t}G2{n8+~^fRI4E}t|& zG=IlciQ%1sfr}hofK@hd4oMI8PWu%ELZK`W+}GMELFdp18Nppd61m|jse#5Nyt@yR zkGRY+xZ@e@Odk^ZR397~GdIVk~+R>$J}-jcQvT*O%${>~!t*oxAdieR0{iFALvB-^A(5Zu^82 z8qrqjk_Y<%d9d>c`03AX%ff4YT>tL5^+#^~mE8KXqW-8^UuMM}+^)s=N};(2=G+h* zWs#{elFppkXX5x4){`ogH5f}yVTMVx_!NJ+-8gyL?Qe$q6-b?L z(jUI(^oW8oq-=lw;PVHcKoyl-DQpZ1BrpFTNiKWbXmGQ-{x;@cQEStc;6_InKGO?Z zULl#w;tFBY72^xp0W56Mhx{v2?KzM6bT{ZwxNO@}`?b(Qid1Z&nYFp{Ro6%{^949| z#uYkVh%XHA@*asV^d5;TgcwJB`e+4=xO7(NO{&KBnJ6qC$GCE){$M!)nNh(gVP||H zt{G~rwFY;GijJ{XV+YLO?kki;u+!mSnsbHtsiU9s^s}L`IHRyi9L;bMK$icU7+8Q5 z@PxYqRMdddoMlCVJ|a5G zX%l_)bfUFR(9<`sw}+TKR)5cdbj4|f@(C|j94K3C_Px!exAa0qKoq4HI{TXo7vUpY zVxq4bI4MvZx`9>`u|K(3Gdqy3oGYWe$Xwvd3pI)n(+ZJY{7=r#UpcuUfmt3suf9H7 zXT6Od%WYZuq=6Rv42%3~?)sYUe}zOLHm)eYB$j`r!$)_0I7q!f1Xxz_=IEaxw|p=iqQy7c zLJjzG2wGIMp)f?uD6|Zg^`lGb%D4@M>Q*|;Ot+nqZb(CU2(5$E$6oV7LD`dFIQkln z0#PV#qD7nf@cV?J(I#Bq!XBC)C-7j>!zP*z8-irbg{cYGs<^Su4Wk)WX#QJ;xFT^~ zG3rXN%{fe0`I)?{Ig7C}Aj4W)Nf3*MrLKmI$EVI-qJ#X>#4DqY?>1et+pghz<;3wt z=E6kmBSo8>sY-N-^G*5Yr;3uaJN0S7lhOf77MGDY?70*eH9?f^~5W3k5D~$$+)`NChyAf zU0CeUUIS%8-#xY)^Z|tH^mC1V-278Me6S2~Ja>1gm3O>~qV1sPS+`~WIG;48joD*6aQc46G0fU$wv z$qDi~`pr*}8z9Iw5Cn6&wQO!8S5JuNe0G`8sLGjmffyoRawp*00ruZFJhX>fmu%h2*> z1;6M?qE6m>qKlnPv=z~`d4f+_@$rYehY-pq!(3Av$&pZjE>c6)X|kSEZr(;ZlMFl0 zSVpH!Ithv5wCSALn&(7w;d3iR*eD(4H`9Kr&ep4Kp+B=W4ySDfG)GA@zK1lJ-Q23& zudt~^DIK5ReASowMz_?%x)+BO{>V3ZWHQu&CN<0`d*tc?Q!)4ozPF{~Lx)+x(#> zgXE1a@A)JM-}h2M zMOo@4%RZy~D)LG8DpM=Ab`AKHHug#P*gEK^y+6)NC&BXJnPCdGm=Fbay-*lnpk#U` zUWq=we^Sl3n%$<`a*XT<*oJW%3_6f&7}i8%QB!=xJ~a%+=g zD7m$D=GLL)=J#Tzj(k)543o~68#F+wTYErmx8xW~ZnrvfYgcmfdofeH9q0TkxO_{h zp9kmw+Ci;xWDx}otl@IqtU9IKZe|iFeXu!HnL0@4<-~EAM7ynnSs#Wc_KLZQ4{y;gK<#MXNgsg?Be8ykZCzSwXPZtLtwl+p|#e z|IMB7ZSqd|TQrL~j&1Q4?0Q<+fUd-wxYW$Pzu&Bqo|Jd>C`xWM(@`{Rjdt6X#>%`) zv|!TQdx$mo`&)#(R+^qR4|xdRpnwRtOWr7W(6sD7*e2M}=f}1Q{Prxa=83y5DfSI# z60M$hUE0;?Tfn0uVobX2STxZ$eE8xTPcV_+0HE``V7=f*fk=F+#JK=lYoYkQtK*~c zdahe3n$>Vc$(Q4RLD8$bEAjOb-R?{BZ$OHJ(8b>H>6NINGf59#!~qzRUpU2tC8mgf zO5!i*UtBnrzX$aFPEgnX9v>ucvS%;JH#O1FE)j%itZZ=}gs1wB4psEfbryMdHsACe z1`-lt1Sdd>!G(34@@$o6Qr211JxX>sJ|*HqdlbEgEJt)tUVopLA9R4WM|)FJXuumk zBZDQ;or^ba+>pF+%YVQIzx~nOB4PvkgJdehF0Obw_9dvUt|aUW`psmtt_C@L}ney@NRzh!3{*Gch_I!c3f=&6x9dy6@0CQGqBiP%Tv+ja3>f^=ZS@A@s z7RR#U$*ee*6=UmbE_)8qql&PtGzW&Q1?(IvFeI|lFMf6GKGk~>?3eB1-y|EjV^~3g z3Yzfce?=OG9}N{s7>wUXBZQJs^t`}IM$=Oxl-y57@sckJBNHPNOHxz@jEdOF2KT#@ zOYqO#b^48k-|Le^?H{cUVM6l^SXUOe_`3WSe&pOn-vM3vMfC)i_; zOF=NdPdPc|0;kOF;w0uQ52>)sESkzf$}AI}D~l=$C)beZip>LB>SnU=tnj0_OnX_4 zZ|6qEU{5$xjKWroRO>uZP!S!ug5^o!4#P6$h+NJpBNwrPGGrHl9fL)zcrhzp%}O!^ zL!$WTN1Ox(_dvPb26x!xt~4DJ`C&g$ib&c}w2Xy_%b8`|`}0)pJ6TZ@b5CaPKdy4a zB)Obnf9cQ+_Y#I!?t9q#t5xnGigI|~=@H}egY?*Xa^K5lOE)XtUW<^o^==iuy*>F# z^S7FbiO6ADeq}{sex+Mr%M#z#oN>F=Y}x2A&BWLlnJP_Ce$8R=^oRq;#OgPBWY5Y4x`GP#&jkt*S;@z& z9$V>OOsmY%v=_y(gGKS|AY_W{1KWWkE{+w5@yrot!gDS|*!%6+-p@VG!X>SGjwbUv z^|7ZX9;<8G4I*o7%In|r|kb|$h#b-F3&r|J_2)WE*|@WJ4e7j|5fn$bLGxY3Mx>o zf~uHl@yxO+DrSkeSpt{DBxp8&B`$sRktk=cDCZL@%M^0Xhk^SEG5W-i^LhUWQ&+3c zX&R90=rCvNbH}58p^f@Q0zUkKNRB5&%6L^!l%p43RLhpPg75cN1SE+;wKH{_@%fEe zZ1Zs3`@QvCMR6PsAH*}o@G_+=(HpsdQCj>vU@wq6R>=Ib<=vvOFVx3+(Uj#aqgf2>S2V;<7Q?0e)Rs}`jDb;9?`U%lq-jH{e+5Zt1bKW{5=7e=x3~Fi(ivi`W z!MYndvuS9E1oa7$f`xRPZe^c1VFzU|&|=doXnFYP-)UuF%(d3JV{9h(zX z+ILia^PSILW}yQ|PmG=-?KQ@q4W_X@AQnx1VttT{zFiN{(tJts=)U0)C|RgO_hnNR(3(eex)S;Kiqqg5MX)r0|xycZBE* zduP|y*VcWdl3E-~^o}QVjsy{d!!cjw=vCpIr^~w)o}jyRWcw{< z8KIh|x8KrO#@KHKTZ}Ci`Z2b3sC^p_JpXnkvs({HVebedYxL)HEAXMb%dOIvJWSP6 z2bKgWWHPK;`E1J`i!L`-D6@s(H-5X`8|ohFt=0&v0zYNd3A$daDj~=&H9-D>g4B+% z99_ss-io1U#qWlcpai{hj@bOUy*&J^+gFftzK)t}>xbX??T|<_@q$lM$8QgEB zv1*<@|2CeM&<8M{F4WdZH{TP=zPjz0uY)MU*vDsh9Q|aX8*`?FoZKGEYZCFN(2YQoRRdXS%P^0rE!@QA)obonICk|Z!{6sjKOoQLOP@dF~}wuqdlkdxMtAs4KX zA!XLV$H2Z*K;PPyvn_SsLE`1rQsEy63@1`RX#KOb&wliL-i>gnaZAVoby>uPh?5a# zwtnY$O7F1h@M$CB@F!FbEqZf_%pLdV+y{c2dLVc(5nL1fjbx1e#`&2{aOdBx13~h$ zsKaNH0c3w{&<7y<8T=~?74>_WbAyNhfmS$Uqs#2|6F2wQR~}{|)y~_9@LBXXME`F< z|K`svz2VkZ)_wyid!hErnlCOlc2a#JQN5o+^-)Ci$dln)Ye=4E6F+<_ydGjIF{!io%009L)Qd4lPbv`s@wo0t|`x?RTNk z338+5a#ag3KDCxm`z@U%DEb0Xy7w`Gy^kRuY#DgO=-xO`>K$F?FfoToCZ8`{wU@*ko0nulo%ihN){XQknGMg5{V#)xJ z;jFVlDoa`_wsTI0z-WfhJQsaIb?(tfTd6Ml`&H4Ps{7>`UZ?njt=(2+c_o9I3 z5AHiiqTE@hKi_iUeF&gB=c$kr76TI0TmzS%*>dV(sfA?w@uki=f^(bNIZvCvI0y}V zS3R;pKh>)FozBu5AEe3q8x0vdTBfc!KRdU=qqfaL!-BT|Y;7Ro){Vx3+edo)nc2tWh2hOU%^dh%4;z+m@D$}Ch(Mw*C-e){-KHGTTGVU&)v`EE&Zyt=3uR43D1>0_dkD-a%!i; zc@>yR4pL_yJSg2*lmx2eUiRkjnKWdv#yTSJw%0N+HwPTHt+#Wj95^6ksVZct#+uN& za(M+sh?65s?-s#AvNUF?xH&R&Fho<#QqAVRncoY}X-hBaDUF!VOY16nv zy{jJ2oJQGf8ifRen~%cEoh=ll-jmr6`BKrh@#Q3pfWzdS-(25J2l<>@ ztO20@<2*V3F(qct@anb=qC>Bh`CsLKnSU$)bpEycbMNwi?O)r|z+vH-iHW=GYF2tY z3%u5bXs;b#W3moYYa&*tBIao#7K>R=Dno!G;c$br)Si7?h}H~Qp&BwzGXxO^l7})M z)ikg4d>2t2@nys(5r4yUq;KAG#{x^gnlw*sjlxR}c{k#P>~<*(Q`OhhjK4vNaPp^@81(xc2ax*d&Gh8rv{2VszZW7SHWyTb>~j_7211RV+I8M;sOp**9@ zoOL+QQzKRKF7$wLl|G!OM>p+W;6eAH6R8Ks@*bQXQ?X5Wo^+lFb;VrrpB<04oJ5E( zOCNBk6r=RlijGy8_vUUV*)~ubm4u#>J84eG%1k4d13A5@cdj={DUblukvJaj`3pSm z>Lw{M5dqJ(xW8_4&trLF9UHhRGYIN_J}^2_;W|BT#Hq(|PVi7+vV7x?B&sF^>9jA)IBl;ncmoqpQdV_p{1!9z^H9 z7*3rVdPFCwj%eHtyv64)=%5Z9bhG|5LGD}g?aZ69fH~vtdsF(_d6T*waTearJTH9= zJ2WJGQnS-4#x!nLN1uBDJ9jP3{RGzM^zH>XI@^}W$LLqRol7+1ObvrpHV#T^8kF69 zxp8I7RUCmSe7@x>wHP-$;5dP)w{Txes;I7lD|%(akOhrHOie?QnjI?}91Cz}rU@mr zH1BO`jy`iM;&{ZV=o(z59kig$zOo(P<05gO6m?_J%7#Hnjf1kAcu_xI&W#}p8itq} zha@#QR^D(dz!|Q_Zsou>EG(dZ=rKI0eIIVO6gr>Kd=)azq!e@cyOyh+MTlq$*)^h9 z-WXzP7?RXTx#F~lRih?Kp{uj7GLU-Hyij|lrTO`mW-O`dYA(J9+J2i)N^VW_#qTg0 zB33p>ENG3$ZtIiOUUMz0SM5bbcwNM2?xMY_W<`9oU}lG%*rGYc?6Y#)Flg{mG<-xs zBhS|RFh63u>!r>y!xu>;2Fh&XxGaDo$*gy|ANtlkozc2AX=#$%*|9V!$=z_vi`5hc zY$&aTsQW$cM{Y@tm^c<2;6B%Y)fXi5KjZ~3$(JP}`qMdIReL)tXf_0HUG3+2ZJw-Q zk3Ql&1^Lu?tM+0`^MaU$>^>%SL+wRpEi|MXw@BrZ2AE&SVbRdV_3OeKWs~nWup%>r%`L)n+mC^B7I$XAs2!@;=0yQvqSs%Q9!7FZI^% z)Z27RowjC0D#0FL^1O7=9`zafODU`eu_%s75Upd6 zs7H?f8?(egO@s6_cQ{hTA(-mWQ317_C)X!s4aAo3UiTCC?HjNIG&gqeph5 z+;;-zMO6ep$K9D}9802gJy4~^z=}+`{U3wQ; zE83*2N%ltmw7#*ZmFz3J6XYTYQWFA#NSAs@tl^6zbuXr(x>b}g?f24C3qHs4h-MI{ zi8)uQoC`GAfx~Q)O;WVXG9u5@fN8DOSph}%RP>p=s&G?Is85Ng{Zjh2_G^5#!#9o7 zGHIpCu|VU%Hr|)=l!R$W?_7xw0;n+HYf+3MAgyqu^izW@I9+$pfogu+9zFJqr2oKu`aw-R>a--Ezk4(0Tki>|as876u<6D<)&Z{`$r9|Bbyt@(+9a;TB(g)ph@cQ+~3)`vu7z(=pyV z?c+fue;t(Qp6%MO6 zIoj}zyNyGT`bPb;zCO!qRAyS5D3X@C->c8trn{6Agn9OAy)=?rloNDn_s?#lOaDH& zvr5-$N8SM-^1hNQCzSq#>B$fjfsZD*n47+XpExRE22@cH*|50jfe$=`iS5Q`pBV*$iXKZ*8$rKrUuGXFFx$J7vz5E$|e}%)EPO zYW_1_Y>AbZ{0UpjDRM;g&-`E}Jb30vf#mnVaw3hk2y$6nB5`er2xpaSRQw2po@odb z!Yft9Kct&;W=Ja@pqx;w!o8vt8N~x%Ou;Lz6ymeMnp*YK{ zARDNMsQGqJNO#$*D7EP|*Xj5l9-+KR(^~u|wq}p>nnMQNoCz=F?~0ku(oY-#cuUgK z!kw}2PkDd7tyg)?)acXSot~XINU{?Pj61ajC-M3d0*D`F?G!O{ zDryN94RI;3^KN>^0fIr}X*Os7$0wVcN)dLSoM>*P`7wX1t|Qm^JbiZV%#n!n$eS|e zIry@dzPWMPn!O(Hn-llYJg0BYCD%B=*}2XW`R-(DA3m2FD<_#bVv_FMh*KNR86V>N z=A^h%T(0^sW_CYR=OyX0-^#G1pY8d6oO3_m^^N0%^2=wx{XQz9n=|ya@*MY&VXTPD z6RY>lo72atB1un1_8@`$cRo&Adj6!nwj8oo*-4H&t)`frdFhV3JK0{E^`*6wvqW}} zIDF5LcPFQBdR}{rtXI{Z_n0%%D)XG|z)GXlne}L4Gb_gPF4upDPwB4U|2A3i$mRRr zCTAZx7pCK`8hr7qqq&+oc*&`Qr?d1&6~kT)GfC!b#O1s{cPBY7J#sxxT&KId{|U!c zB5|qy&y&n)UW#ldJH3!0IG&+zj*uDkrs*9TB;`%(=@jYE7;K-XxR7g<8HZO(ngi`^ z#zNCoIL&dkOGj?zPw_;%?ri#3_e<}_RX(YGGw5V9e&_wkW?ES0$z~>PuPfA%izSJ5 z3`s-6YCpo6u3YDD4_$R|%P7II{H4f5agFCTvz%y#O969HHJlx?Wde6Rm%r1WsX@Jl z0Uc8bmc=xGn*UyMWbCkJ-52i;CDF|1o-YO^UU=v zTgq(1pY#-;wvSY2qN-?aXtuQ5pG2V-?0U|njLh}(WBr|*Th0tI$7BE)N+%)coF_ofn*RzR8q{n=_9xb!MgS@(I4ik7lJGcuB#RFFzGW_gm@heXJmhWSpLMkBUR$n|YLtqm-n%&8<5% zJXtQ^OLhKfJ?vZV?USYRu{&f_o=7fm)o}xljx%qch*JfwqS&2_VT_S(fvZu{YO&)r z>}P+#)|Wd4-}RLa#^mAj){TN64k4t+((B{zl>LQ*@34a4h|P6&$P?G)U>Pg;sg$T* zcX{C(?d+9iUz`1Y_F3193AR>pVsYu3Z2TRuIde6XPzlio3UwX#-MzPW6@x^CmzZ_q94^`4M-|4>bPvmUI@j5is_0l!eHM)}T zRBv?PYS|*?R&LUi*Zfg_7k*Xd=R28ixt@bH5NF@K&{Q|#w=*KoaT$LlHqUch!k>nD zS0H^P{MZ%<2CKp;r?4K{CwT|$_n^!zuBWKtM?UUY;d+@6vOZ*c$o`PzkTW69kV_$> zD?Y5)I<#$QxTlAuuGdD>#By=v;>*o0x47J*ax2O$FK3t^v~{w4=XuNISKd~BQ~8?Z zisV0CtETbC=G`rmWcRKgH}6_B zmdv&B!ZEE-$hKMc%9vf%>wDld_Q_@+=RV4)t7r87c#r;PeK{6epu;W-`K3~g`j&B< zem5rt-wMuI9G90gZfIOyM87F@ ztGahT792U`NshbovC(9|J+w;RhGS*(+dz!g1me&fDR!(>gl1(OL7xc6 zhO>yyk)1LIK2d*yGSGJ6QicqV7fY2vizn{C*Pi}iB5WZ+>Y8R9_l+r*b=(ruMW!Y3 z?>zBt?F~x&GBg6wUMVXLXTO#99*Gl`*{!lCO*hEXaB{0`q6Jy9IiOozWmWoN&| zpTEmyj22LXPT9$55U^0P_6p(s-rB3Qmon;S=V#s-cwY^El8xsb+5i1~F5Ug?oJGz# zl!%re3vIhRvtDBSO@c!lqq1h4@7mSn;~bF=5zIVky_9|_-R?K> zh0BJW2s&kMl?E}H$%m7Wppn|l6J4YSym0<&oNeZFtL?9tOqb84zc5sGc1VZ8rN5$I z$!=%niJXkEywz7}YcfirauV(I%z9tOyi=s!b9i5&xb%}&=i;r&vZHYxxThu??uX;q z|9ZIc$o(+5LSlu96~XyqE`?P1 zXULejKEuQhdt$fUqQiLGh=qT<@9bQ6H$L_jLt^c1eYUoB<_Z2FD`PWr=ZK=GA;j;KeE>}i^*cr zI9V;QuxeVHiXAKV#=jm#zAGaCex)zf*Xeup6Z$pXsrRnfsAR2xBgOU=@1k7wuDJM< z=K;qG^{%+f`mW6%#9dTXAj0q>7g-{vJrdx2wd@ zep+Gq_p+9+A81r8^rqH|vfwh($vu2FMfanc3>j{YsCO=&8T-}hE(SJk?=qts z45NSi$E63xeH1Zmph7YNx3tC0`MB5Z1^+nnS^xdjAh46BD@09BVj$K?$a*8MT##Km zE`FuKqfVM0P|WO;rbn3byZo?%D8Jzy9$Y#KqWC-4r;A)!S;qroUj1K{ZEgo|mu*qF zBm4%1%YqJ{iL_9xzcGUF`R~sCVz@hc1b^_Y>!Go#k=w|iyhhYCDUVv=rwx9H8htb9 z&ik-TZ7*ynZu)(wwdUyZ2;I$yL%! zzlSEIJ#u*_+)4ZADPtogq}@-ba}(h97#y~km5{nRzGfs z<-LSE?_Hn9-%EKG_lQ+bS4QwwLV0_nBF<`&*Vt~$Pv@VZh~dtAxz6xEv%5H2iz(r1 zXKypPmCEGJDmz16HI+}9C09k6yEJFQ^-KTc$bNsEJBgX&JY~jrh9VPjZ+O;mwBksf zJ0hpcl92WcF{k~7gh9xNd;X9tgpvh0zg-#aX~#|sZZC#tU1t2U+a`PD%lWX9bD4y+ zq=cJrE>Ar*iYb6srPz67lc~9rk&yOYhW*MN*;BmCwuPQXIB6L`dgxA|yKFxo&JS*r z_#xRVmqz=>gdifAs1imAD*RXc$ujEiWJ3rz3|CU8B9V}i|i(lY}!kej3ci8 z@^2an2zF^7<2q#fB&3Z7=EM!j&Qy3aDo2&fJ@xyeEbBWNa+zuR;(vmy(s9;FZa1mOR9+#-h^T<97G`c|*~eqKqgkFBNO+=bRP9x@ zf7S1+Zmzn!YGT#2(A%N+LsKg?uUxNk#T!$kN8csfoaBvOXX@L8jiD>DHDIhR

9I+HPgymRTFvtuw>UqMgr_lSkv0yx-!rg|e?tSJA@l3{3{17h~cqYWR z@S58KCfCzk&!D2NC$fG%fTqFLl#tvgFuy^M%bWgtrDb7xYIptuQzhD;HyxXFbZqx7 z-k^3ZjJ0s3YyAc>mbgcE<8peqN{1!A{?&dbEU8P+dRJojh^}kNMN{ zwH}_YS*7B#vk}#k9>2t;PpcjWb&m*8H&n$n9E%l9^ZATO0cQ= zvWX3{H#LYcIX|bs?iYhtj~>00KYLL};qYbHsQuItPohxAh1aCnC=!~W_F z|CGS)Po)Gm;iAkvr#5LZ-h0k(vcy>ST-f9r!}nZ_KUV!wa=`I`y2}z4EecHTyt?+X z`0H^GF?>z3Yh`MCnr9s=WA?mWWo@NT8>E@-5e;se?QI*}tZHx3;Cc~zvj(?{*c&yt z9%!%I;8vi$W`pas>|PCS)v{X>Za#2s%ySj2GNVeRPxGoe6Y`v835HU%w;NVM{wgiA zAa_n5X&M(&ec8u^w2*4cdL^r(mo8RUTDF;*+x<3EV|($e=1#u58})%F`Of7PCHzDHWfda$jyL!@h=8iuT5?rze+g;7mr?&9Kz7xk)k4 z6VFq|{tM@8HmtVneEk(wj#NEgE1=Rcd3$7)YRiydN8u{V&gPr_^Y|~?yBIhU69ZC26y#zU}^6QTB{hPYs8$a`k zVw;9o+n@TGliecHLXLOE*FnoO2POA3I$tWmKtv3}3cKt1zubqN4w>EF zB7HQ54|C`dywe=49RFV(@vtNrSpE?WN6DGlTC8bLLwJV`EZkf2Ylh62j-16*32}_K zgwz{vwTA|nI!A^a?}jw?vzo;X@j53jCG_>YqrJ?5A#=xDu$|VDEb~8%k|R1rb~AN$ zhOu7eem#41H^PWHnCuR{u?&6JwU{~~j*iIhbW7;P&`aYqaV9JkH%^TA6uCQsax%As z=Hf)fbVNU0i}8p=fDfpbxhIt4l!|CLbWYK_B04fb(s>W{sAW6j>$_{P(4u9ipjsb^Q#G}T#X1-=h{)v?zmg7 z8rcg3%Q6YKO~jiL5xguVGs^jwGQ*XflCr<;BUV7;n@7xAu>dwdo(l z#+`jJMPMVf+e2!%vUXQOS(V%g!M$#>z9#Q!bYKuB5PKRQ80=2571QFF;sKGkfiAyF zo-fri5JzW@*mcKIL?j!6-HrB3U%MOc&-dl)+>jU32p6Y7q$L76;Y;2%$Eo8{p79Tn zlJli{1V#sjrG~tXkzXr1@2KsX9fxCdSBZLfn_XnCx6Ca<{>M(XLwX;1kC2q1)!8O5 z1{We&+@VTgAb4@ck%F)jscC)=`=}Oj-VL<3R854&xf)uF>e?IEm|< z|5dp6C8YTdd7ClBXWdcXvyPXJ4{z^BL^@8qeTe-uC*R(8oa)(KTo#wkx;>ZspPub~ zhpZU#_WcmY85IV8o%KE2HS8~(T(C69w`Ql(+Z(o<_J$K}&6~eXLwEJ|rai1HHnnAk z-E<)NVM%}Z%1yYbSZTc6IP^mCyW{j$;zGf@?PD_fxC-~dQNWDXCm+6Dy5#MvrEg!s z%jK|}SaY!C2iClOj5$A=KKZG{m;65Pb)*czDC6jmBTs$L&b%LJH_81%4?g_wP9FT1 z6C?vpavZlH!Terp+m`rK)&Ei=)W~h~FWGLZdnA^}ANh|PYrdOf(>+lJmUtZILm8NG zU_|W4+y7UgN1_WhmZgII@;vNxy(8FHbHs(FcZ=hcip26y0IJgriTA4h*R~MS$60W9 zYF_-2tQ7ISWxU%hj%3Sg5@W47vXiV7pHf|Zk+t#?dM3I=la||F{~Gg&t({>YbzafU#Jq9IG zPNiP$U|YiDTWVWyJkXGq75Rm}!7x83>bk`l&xqspJT?_K?VA|QKSb)La-85GYh`9I2ZFUe9<^EpC3F; z>pgRtg{DQ}eyKc~-VwJ;<&nJHAAkNwlolCf_uPNQgldH~%LsRD4H4U9cWiD04;7sp zc?5(XpRR?Sp6iuJ4bXz1=l9yd^K^G(!uQlyjhF}8F!ZK9=jw^?!wx(($rG$@$5mxb zZFas?*3r1c4mDsUZ^(-&q`c$(Vkjk6kfzcD8ogcD<~A=hw`<|K?fvKWDR#1XiP1Gq zHV=Tc>c7KMaS*>`B1grq97i*6VCx^oeyOrX<+lg(m&MWkIC76B#zDivZq~bQ4~m0X zF}wK8^%`rTDRO6^I}{n597QBMdm^WfGvRNCYK|lBziQW^<0uN-*?^W}{I)-cvQEUs zSn+-!HTTqm%<4&TkEfr-<(=p2|7?0#|9maeK;UxI-TLQiemq|%?R%gA~Vg+YP&qEo-9r?G2>l28F$zz;K=tA%2iyWe-3STtV(I zqiu1nB5}#4ai4ia?__s9^H~r!{^DAo`O~Pd+3ArN z;CNdYcch}H#!U{MICIV&N9&!z?=$s|Oy!OvIa@IPvvhKt+7XnwrAOwvz<+9qJnSyp zk(LiVkWH+ww|wx{`FCzKf9T=37}^1&%&=71aLo0Rt$`CqRefZ)H}gHtScTp6cCruX z?wpk=x*#;-@_$)9elM*GP_#|na22iZV0f;cgkP$YHo1G+m{2Hns_dy46gD!#c#`Vd zt4Cyn4Ak9=;mw%4QN;-k0+YJy*{g}AK>k`*_!!%b1ZI|+rcJL|24PpB-t zmQaWa&?^c4fR_@A1Ek=1F+`!f2U0m?2HWie5ZBinPzrISN|RtJPumzE2nm}Y6IR;r zUIr#Ag&~Mk1z657DGN{`mp2?&1jwydyn+#FDAKG#hd;dqh2js9sXcuSOB_sWWklK*nvjbv zWY#v&A*|XFZw(hyB($S2njoPgd9y1rgAwq)PC^H`StB75pybmPpybmDprqObpo+UQ z)ug|rP+N0wzcp0%*tqUjUv6z;M7U4KNB&K?jThc$opC0T~j$1lTM9Om3-|6)+M|O~Noh za|t5=y(L6L&hn#=1IW#jx*ae^LJS~9!bFsg64ZEr64V4Jg_2J!vZM5826a#&*`^te zrx=c>8d;75C|{GPrCa?bQ(L$9>5#@7Dd(An_iqgEUm4zI@hk7M3^%h4H*;a7QaA^o zQaH~ri8o9fRLkvsJ`(ze%-0eloJB@B3jj(176VjV3#qnS0e(U_zVK!J4uJb%$oeBd zZUD6=0AyQd{ecF$g|G}JDm}{qDm^OzD&%hgD&(aACA#kcO2@VXR1~WLDvI?8S4FWI zprTksZI~=E>#ulLQTzf>QEWrpD&(I5D!@$u)go;LJd@(x2**z)tOGbDtfk59k%X0i zdlEJv_B#@`0B%WG12w)WAqQ$hG>iLNSvOQZ0I@)dlCYcV&@l2|ymgDWw65!h2r{yI?X~LI6xWbig^7d?6taCXY;jAV4oOpg3T-1yBI6 zTEba07$vNL$MAK^1~>z#>Fqy3jHS zUaUJ^mGBAcNv-?YzTO?o;MTkbp5AHhn&Q8<|xZ4u$JzSZR|6*8&6oRSOKdtuu=hf!z64s zOnd+lGQiTTtvgab_)_T+tghRnAl%4}#diC6v`WigZIRwRS^! z7C=cJ5N`ZQWg~?4>rsY^4>MqNx0&5K^q6?@5koCe=8L`Xl(zZ~fS=Eb*EWch< zMdD?Zu~mT^<*SBaQU{<+s>(R!p|)rEC% z%egbOMWwkrOjHJ=5VDeUH-M6ASCoYsuJktC^fcV`GTihq+zf;pqbZg&URk zegKvC{s5KtKJcZwi6QW%6ksr{lvFL-ovB7LCL3;M15{F{1C*OthMR8;H(vo%T+;wbhF=4e z3}*n83}*tACd4tjTYKliL?v|&KzWY`DDMtrr#y11&jZN5NuO^xUSK$00#FiL3{d&P zt_^p9iwrm40aWQM11QH!4L9E!ZhkP_tT5bsZ@5`*xLIkq`N?pTV7U3waI?m6v)XX; zv*Biy;btR1$#6YDC2WJCHfs&X>kP+R4L4f=D)E~PH=7MN+YC+E&iX-28-@Q)Hi!la zz(F>g92#IZ>%_j2!@_;63Hz!P-~iz3ihx6GB+Uu~{Kke-;hKOwtPR@`4%iRaBH=LL zR|$IoyCft6ev|M!;DCf(Y#<$ykOX)v;SYd!Ex-;nE}(AT>e11VF_lJrf`=A<}OlQu#66Mx+Yv zvN$(nAz{ko6)KT}2dLc&-m|aWpz(aw%7GA++I%nsC19m0S}v?qMau@Lddgv?>gh+A zsCr5;QQZyW$fRtD@{mH63m=}}$9WoYc>`2jI?wOgykMf@vH(T|$AzJuCH7{IqtgoHtS4|SIi%;!>n38ndb8YUqUgW@p~TJaz0oP?HqIi*Ob$G@d3 z658;_)MXf;CSat5W`M6HbOZb-;d8(q37r7vB=iP6lF%Q8k}cs=NFzr=V@N{~l&uC# z)QGX10gV9iqc;R7(KP@BNs|_UViH0CO0mlz9Qn~(15`M*U?or2=%oOvUepDACQaG{ zLL_tm$ktEq2v8ao0Z{FH9gZ)Tl2*+TAl7S04}#S_2>}3Hu19)TK!0fx1z07aJfOaW z5&$(QEe=rLdjjxvYC`V?P*IcxNHe_;qEOHmppwxKR_IPiZwDwRp$R~R(-fe(q|e}3 zb~pN9n5Y1&!9;#c!}xD>T8z~E$MXHO&2(I1ZppqG2UJx*aA8 zVql`&e3@@zTEYWhg8-NEqjZe{7VsmqlLHpQanp{?dg#*ut=lziuP*|$=or~vp8)u* zeUk`%JRqWJ`yf3Q(6oK4X8JUKSjA+V(cRbk*t5Av5d@un^N>UT7KLBK6 ztt((9g<$;&bx;kumIG8B{FzT?s_Oj+P}O`T9II;nJwR3S4OrPyqqwbzU50F1Z-l%B zRZoSy+Gt5O^Hc7+yveBe>ky6#d94xhMkC}k`~;nmjnz&gihV{D+l?rGGosjLM6s8j zcSo@cxp*(V?=Yg+V?^<*5ydY6)gJEVXK9D*n~q@ZO=^PeDDT76VCf*@QvLgJ#HA#b zh@w=2N$tZqD5kyNk27!-|kc^~8NjQKgx=1(-h?H;$1=m5sA4oI4HURvQRDKciLY29|FSsF%-*dwQe%}p`k$0t054rrpO5`*hpvwIbKq-Q3RkRAjGl2)OB#u6$c3Yj5mC4f?`ssJesYZW9zRnKY$ zdsPRUB zfKu84fR57fKtN#$p96d(3B9kj5=H=&csl|7 zrO8Nus??(Zm8HpOfEwF;31}!y#sE|+F%}?O8$BAJ>fktl%Ca5MNLs}JDoKb1w3aX) z&{)C*K#+uqfF=?q0h&sf3{a{*1yEa>Oa;`E&=a608q)#oq)8k=jazyH+DMbH0Iej< z1T>TIHK3b>ZvZVN%mQ?mFdHBj&-6Kfwi4z7>PUzOsJ6}lP#K&DP%XfGKxgS@0YEj3 z3jxig$s#~W3Bv$tgti0_Ax)M7WJ9fg50DFW`VWBe621c{wOI}*Ax%~Q)W~y&kcEU6 zX&P!%5eScMLX$#-8n*#ZUcyR1EeXGhH&ATA&mxmXNl1Xz1_@im-}FGjT9}v^U=<)* z!ZyI40NRD7z*jaz>k;W9S#!4l7E9QUhG>a|%_5J!ldujcRJytbFaRmiR|D=z_yy2k z!cTx82|oh_T}RtEs8LECS* z`Q31H(11S-IAl0JVnljWyhD@_Z!)YD91|bha2#$_p`0+_BtRwp6hP(uG(djzGXPZ? zT|&Ug0Nww*$VQ6Rw81sZw<#4G}+RP*U1miP(pct{621~ z43OW%Ess}H-6cqdNyE#sYY=a)k<*WW#t1+!3#*;d$`_ytB?nfj*=Y}xUDB!)KowK4 z0iggT%rb!8(oH)+kPI*cAk(Z@0jRvUHQ+NqoV02RkdAaO&3*5I$y@W4k&~&M7UYH? z&3zYysfiZsHYu$Ya)XcN=Y}>~RX6CG#SNaCw;L*IrQEPy3F<3UbAT5E;K%}PmhcTA zN5Xu7KL;!U43gjg>;upi?Q?cqnvB=Fvnvw%Yn|Cc32|Cq_FBR!Z6Na!fY0G;q=Z?3 zGzl{Sqygpt!gauAKqnI*0x(X(G{8VJpd(%oi{NkRstrts5KU2N(#o@t10B z2NaVq9Z*8TGC+WYuK__4CIW&b#G*_aL*)8kz$sbE(Xx~!4AQz{aR@LPAWH>D>AEsi z2d4m(n|_Al7?>#48V8d`GQc4K)pz&N`n!ECfXPW2&O*a#5kP6(8n{tWdaymYXKA@b?i65*HTIT03=G-3&@gi2vE=lI0#rQ;W!{e!ZE;PPr&bhM-mdX z0%&qkrbo5mtiEhOPNI~DNI0xnX_$m$zz7L@kc*KLlC;5WjD&q~d{x4Jz;y`+05>F@ zKz6)oLmu0u4RYt}G^}L#SWf{|Cw0bvvxe0G{O@UniwWyK_P;=qe0JSdh2uiD7yFWz~E_8f61EAi&TW}w+ zO6mtVR!P-#i#w^9$*C0D1l*_;=E051U@lUqCP(jKq7r6?8ry%a#jUIw6I4+1EO1p<`BLJ_+X zOGSVZO9kD%H^UYNH>yml0+bA^8;(CU99PMAY^@9vRhz2mU%1!nDgjh_>KftHF~X@0 zP?6REs7S-%U5TY8KnbB1Kvkk9hWEyX_eO^IdWQD~hWGl0_lAb|R)+VMhW8eR_ojyT zW`_6A4DZbi?;YSqP8F@407}){1C&_W0hCyx04h6e0V+Ff46#HY93_^n09A0E0jl6y z!?7y3E&wH{NPsH1jsR6~Jpd}??f?~XHzVXeFj2|q4^YYIXE^R@IPQ(OlvH~GlvMiy zlvD>9-iI3AhZx=m7~VfOybmr7ygc~J|F99kUBLFHHqX8<-!vHGHUl`#GH^LcZ zgky&r70!5o3MU$%!ifc_aK->sIOB|P#v0+o7~xDayiYZ}PcghtFuYGPyiYW|Pd2=N z4L7QkX9HAvW&%`tz5=N9%mb+O%mAqL#2IBV3*o3zb^uf<&jqMbo({*Vl;Z)al;;3c zDSrb{rMwWJLS6t+A~49E6uz8l*L zJ%25CIigTWU7zpRx*DLOSeNh1x(cA8SP92UZGO=6m$QC?mGb^0K;FB@696j9YXNG5 z!3KcJ`x<~+{r(x=l@NY~iIVCs043Ee02TW-fXe%3fQo&S5&K3X&07(Uigb_ReYfF# z7c!`P?J#_8H+=0heC;#3r2Tq+SG!m5%2ZGEo1VXlo(Nx4WWEmT(HM$sH~A;&E{4J(&Rj#v4lI)3Z!2III3WYG6fJPtu9F` z1g&3}fDrXG2?$ZYApz0rw zf0NvYa?#|UEhPrA>NyJV0wPxd-d}u_&=|rblXRnF?Og$;C>+qWE6nngV-0KXFxj#N zCc1Q!1TZPb*w|)P;DOb61y<5M6a-;4UV$&x@D-Rz_f!x^dLapM2*+EQ5Yv4CE3llZ z`vTO4JwL#?b}%UbQ0i9@Fk}c!iU8zQqWUKQwLPyeK<&ya3OIKTZfpRVL%kSa$YYok zH~C_j1>mKupg$!|-fjgb0TZPFL8j@@mTM;e@+Nn?Y6}LaHmV#zwNW7e8MdvIDZh~^ z0~6)FEI_p+r2(p#Dr4vU6aEwn-T)y0^-MTvD`zF20m@5=!q@Xvlu#EYRV35|RFhB} zP+dX0qb5ipVMjvkJD$&YEUNiLKF`kCaKHK4wUyP-Oyp-jGjLMrHsC=_%v zm3BjW6oE474mDQrsYx!}Bb;iuD!w&6vLroNk{>2j@*fb(#Mg%vTwglk4#~cz{R+}B|UN|AGtX_@+?n{uH5Mr-@7(7(qDXL z-5nV&v@z+CNn-J^^vH9fu>DeGw)i+CJ@R*b{I=_nAM}##u15x%3T*1osiJ8z{K|tp zHoX4uM6=?BmoVN~xc0@n3O|%-0aW%vG#@!whQ+n1*n&0#gN->XfL35**(z2FJKusS znU$fltSsGPA@q=yr%YCXOgxmlc_nNzs!SogDz+9?!*-tP)Q*QyA6^3sm*HgRwdgBe z2j8buj~4R!^c`IhjQZ@)WJ8kZ6t9j%}!dXiJ}p_7pBU zQbQ3z%|$2bDk7<;=!{)~U1_L@qAx`^iWNO*g6K(WMK9VUdgFaYAKD}O(m~Omj)(zt zOngo!#b7!ohR|g(l&*?lbYBd|iuee6E53jRkHl*9D6(mz$yfW53TR`gxHgVTYIX|N zVyK)Ji)HKa^r6F%mu4rB9o)$&VwC?my>p>s2o}}sh$fWnj3+#d9rw^jS`d})m51{~k z7?swCQ)PVw)zL>%Gkp~G&_~l~eGJXiqiH=3ylmEEX|FzkuHl5sO?@&s^{F_bK8>F1 z)9IZaN8E(dD5h`7%QTA$m}XNE(_AWn#;QJQQyb`8C&+OiR(3~1jxo@^Zy;5;fG(D# z<wg3!*CqFq?jO~y;&lXxq57QJmM-p}1eXZrx}ouA-kqzf-L|3aVp4yE!D zT`p%~cpFxOJXuXDz`}75t~Qlmbtr_@rP{0>wPN+DA8SCd7*EHsMku=`D7U7x9s9En zux8jS+MJHD7IX@mm(O6R{U>(J-(YR%F7_}##O~(|))AX3Bj^o_r1z{d3EqVY^R85m zM^Pi*4ZGR8W7Av@isikb`+cDMeWCkp};yr}{A7h8@HC zk5f3~a0$mhZsSCP6K4?Kv%Zwe1`y{1sUZKHitr)WJvfwVKo+$jhvtw&PspGT{}Ma> z#$qF&ordukis4gn=x-X$;nQh8kHbcVujmIplUDMtX$}8|Hu71tjnBa@vUp154*G-7 zqodfBc#bcitJuHr&R3;UDKR&TYE~6G#55J6;gGl1KOXiDET3%H)Bx#<56ek zqWo8&{8#1Im!nuTzYHCC3>|ojdgFn1$P?{QL9{~wXopI(N>rXzri!cz)nrwvE~}0g z9APN;8Z-d)W&*2)wyidO2mM$L{n!Bg*b4pl1^SVQdh-W#<0y3FPw2*D=teH|qA+ho z#d&LN4~@Wi$WBzAcc!YS7d25YYNK8>;611*?@29qFKhy0HQEWGf$m`tk+sf{yHijvR!J9DOFq>~xaH(rG@PF7S!i z?#8Zg+Myx(K1w^2B;76SY#*EmYy)_je0Q-^cSY*g;?nR1nB-0)(<;~2GF{r?F4XW|FU=MtzebibJR3HzB=QHWSgwZs~#hk6i+I?zLG zq!FkGW5pJV7h7o|>cCRy|94_1tw0_45p`fS^nU~Nf1B7(yT$L6C<;*%`UH|Hf{h$S zsgKgn0Gb5pe+}JqKsOhneOiO|X&uUC6Us%l>6cJ8*HJdNP&O}6Hm^`NZ_u6>f?fu& zYE+heN)@1=^`V~)p`T5mmjj@aUqB}(Lnq^)lixrmm$OFnBigO)(9PY@%@fegGtkZ3 zXv<$fKmSI%m5s9ch_YhPPYd+Z3vIVAbo3MGXEEL#eRB`A<2|uwx;KuG_Q4^%zSI@E z*#qs?2((+Hp_`MSn-1vaLg?g=(8-<9$vx1?eJHmBD7V8Xvtwwxq+VWzUfzXHW?;O8 z4IXH>D`O;9l?p=l0-$^4p?lS_C#5I!uMhO^bF|CDp?_mBx`@U6ZvsYaQ=os}K&tbo zB`w9oZx5z=H?aHV5jKszhX!-#mJjqQ2>KL)0~3v)PtBoAb6GSwu(f_Mn}~Wk8Do&C z*yulv>y1OhiINSOv}V6x*<+ey10N-w-<3AUJAVtm$3YBnY^^C zR19rh9kg{Vw0n46n@*Fp$9RA1!ol2U6tDe7OSG4?LVHD9wb%5AmW6ikEj`fQ(Hkv? zEP5^#)AJ}86O?kgg;l_zzskCe)zZCK6WyD2(|y@6y&xN<7h>b}!Ym$V0TXn8wjC$; zuvW&7>p|=y4(~m{X}?Sy1~i+>v!bSoth6bV)iG6OZB5l!gy~b((-g)=nQE|UrkZSt zsTNyjs?Ro=8n9iaM(nt$F}rGN!k(I%vm8?krkmR_FLQh5XYR;Kn^)(tGox{-Zm-Orj^53p9&-&s%VDc0M1j`g>mXTz-***I$oyJbyf&25)i zlvWFN@N@%h_)Uxt zZ;^%FK|gpGW5RnF@7$+m>;ZLT>C}@wrV;E3jbu)=*%>sAJ*5TAMT^)o%!QuQ8ukMH z;Cu9eA804b!C9h@80Y6w3d=(uNbD684ChstC)b%bH?aV2W0|U>$iu)|r38y73~cKlf*Ic_3TJgV;tM%ntI>>=3WOuJStUHm}R>^ZG2EH)PLw zBW4v%SxNC3D<_(;0h-4i_XVy=2VIxIXHb(SfaiTX{Ec&pOqAyz``m^0) zAlolSuq5#XJ0?c5OJX!DrrB93eA{_hZ6d3J*?KK)8f&S=v7Xv&)>oUu2558Hms&iV zs5#h7Z7G|rEoTmG1zVu~z?NwVEJ0hzE@*3+u5V=?`ZngJ|H6FrUs(}-J1dC`IvVS{ z*--rt_Jw|keW@Q|6ZB*@O+U`&=x5na`gyiazrgn45YY*oF-p;|v77o$_6R43Uh8+U z=*pYnp1>b!_0j2E-i;N>mhyt1VhuWG5y!z^`pxTP*{W~t9xTN?1TmWI5e zr4f&`H0J#+&G}$UTRz;-bv-X(-N1van|WF57GBx9 zjfY!*<@K#Q@U_l6c_-^$-qpH~_qXonBdiB_jP)R&Zau_jTa)-=>ruYZn#>PbkMpb6 z6n@isiQl!Ra;NnQe{KDfzqelJ%$CMIY&W@=?G`U+yTfbQ?(w>|2fT^xA#ZDY#Jkwi z`5;>cpJ02+=U^ZF54Pugwe1DpYJ0^G*s}OBTQ)ys%i-s2ANd1YE`Mz!k!@qb+fx&z zJatjQv!JN#`HA?{v#@CFSwwX7^cQ_Si-}R5#l-~A5@M!jNwL7Qlvv>zEVg@=7RNoy zh`XL;#S_nR;*Do{@zJw_(7mb)53d@+%PU+2c-0cYUUfw|uX>`fSA7xT)ll^GY9t1D zH5G%sJ`-PfH51WZ&BYY27GjoHYq8L)tytpKQGDkWAy#;G605u-#YV5r;#aROVwYEx zNc8F^4tVtx$Gm!rlU{wqS+9QLg4gHbPp?7Zf!AR1#A~QDCqb0;StrW*tQVm^8$~srO`@*PX3^Ydi)ib!O|4OxR{0zfyL^s{<37patj}4I>T^z9^|>H! z`dk!Gd@hL>KB?lp&!58NdsTS)-Vp_T?}{S6_eBZc2co?1BT>yaUDWk;ik7|^qP_1c z(Z%<*=aJ->=t z6TdL6m0u05onN@t$*-2y$FGhy*srekrC)t*ieCdQ&aa6!&#$Sr#IL2c!mpL~lV59X zqhA|spIg;(N{IVMf(lWqcuV=)|k#? z=Gq|`uU5u9TOPS@z}jMN){X{a>^dIvj5y3Q7GmvT4dxnqG1oZ7qUa{(-p?`jW*Ea3 z!W^p{#;`3gh8==2>@407W4iuy0%O_77|WWlHWnfVQ46e%MPN;=3)aMXiP2bJ`;w-L zu{1+O(;TcptQ0XA-;c+7+61~NCSlGynKH#x^3bN?I-xkKqRpTN+Dz)KeN6+kSs2sJ zrKwsx#&kP6I~$K}+!OG|VTL8H( z#GH9C{RW%kkl|&>@H%GFci`$F{XkBP(*A<$Oq9ZVjP-Ic*3%$E54H~Tmi1VF+Car1 z$3V!jEM!-e{emx5{1s~w+o>_zK`q!$YR7g#|9^w*_fdbybO>bn1!Ovg{f>F|Vax-Q zP$!PiEOr!go@9*Kj$!TM6eX~;*k5~&er4yeE_(sxk%~2{%P5a4m>d3yd3PFJVK*p^ z-NgFdEqa78VFt#8&oL(an?1z3)gv5%a+1cMQUUJ5&fI4>H2W9UuAWl`{sQY8FR{My z3a4COQxlX&OO!`Dlt&bQk9Ca?m@{T$Z8ryVtB+XQ&7~PApV=s%`JAz(oU;{Nu$34q zZo)Y6H;fYxVw`w{+t^8r70+X=c$s^%H15OhV9e;`g;*BGj5)k8W1G9}BAjg&wb*u1o9z{K*a1-w<3)KwLSFgQnS5}`OL2_I%RyTj<4t1+ zyeaC2(RqK&LnlLfzDCVkfTzu9@pjQbtf35oE(}IJ8v-2|hOzf>^27YJB-T4>vr*K9 zji&Zk^BBg)(pbz_r{YZbau$Pn6pL~81hi{d(}50LgAUw;4m@Fd=pD+r0FIDW;m5G9 zbeuY%-bC>kSNDSv}GZ5GyA-(gMU0~Hn7ILMVtwM8Cv#0#@1?BDN&BLLAtXH&78ez7pK?}df^ zBs|zE;mNiMZ{w6j0K*GjaUKf~85w5{vVwr)bZ zx)UMnM@xDH?doZSbO!Be3fk3MXjfeb6)PZE`*L9IYaz}cF2c*)#b_s&;-J8{Sf^ix zIqP>6%$8GWwt_;@KZT)hs)xR*F~{1|J5ZN)VjjB-YmmFqCho_&;{nLzAlkz} z=qL0$f1s^AjQaB$?c^J@lR0Q73-A+oKf4rl{96)u6KFvj?u8r`KpS2Jxsq=Y$|EAj+yoi3}fA#j=fo&DZ|NHcsWIfjq2S_6jNJ4ckS*C3ktLrbCpOhUXh%Cj@9n5x?!NTn4metl0}eQj-VZoBgnD#BexKRhCre4V z@Avo5*Mz5eTV`ixXJ=<-_r3QtyB(u`Cr152cnM_B6f*uf9R-@LSda zxe39Kk3e<~QGUc){xjr9QL>6d8BtW_SVdQUt(eL=3g);{rre-d%B@Pda=%ikJg!tJ z&nlCZ=anhSyO6PuAY)%B)0H0}V?QY~6&3!w1^<03$87liJ1RTiy@0zq<|@0xpWnx^ zi{f+asC|5ax$~BH<%5``(;BAf-$~}&5#0h$o#~lY^jW`%Ff9u9z36}} z1flOkupgFTw>Sb>=z^WK9P?%cY}|toy*(H*aR{QAhr-H@!S?D!#JmqSMI19~5O!D+ zF<>#9R$zV{g!yqeBp`#?l!N_oBy6-3a6J(caT4al1(^MpAmwVLT#u9+ARV{Bc0i;V z5_K7*=Wrb3#8yy_95gB8XfcIZs>?V!gl);WZ_=SnI~B-*8FXi zzhmAY%8a#t7v%+Z0M-zEuNVEh3vs7EKquS{o$x0%4c7SfSh03Tdo6<+0{R|7oawJ9@hGJ9Z;;9-Fn6DXG(HU}{0HXnb6De^XJ0~YzlFs9gc2I;3m0sP za^)?odv9Ye@*UXs@3C2kGwq^$fc5V~yw>q!tbL!b;~~QrKz1*K>|P0(y&5umJ@na) zkWHMgP#%G7J_Xr)K{1rqAfF#WKEH!({sh_Fs8m4awo9Xl)MLMAVD?55oAXjJ~-SfKm~GI@__f=AfJyxKL74$!4pWW%1e$m*e30G2&qGPAM&~0(S_%bmMdRF zKEH!}{s8&h0QqEyM>!CW(h-kxsd3mX38hNyhfEGAlOdm5Lq4ZMKBuc`Wji$k*&K!~ zGlGXoRw;GrY9*l_h1k~7N=7{fw#&G3lzO~!yn2Fiih81QmU^;so_dOMsrqZ!FQ+Rv zsb?s+s%IhIb+&T9x>k8yJx6(7y-;~sy-0Zta{m_O{yoV3Cy@Iu)ytLdAp1Y7&*3o4 z^Qx-7pt`k})XCb*>h{|E>Q34R>dx9n>LTr9b&0lKJy81`pB4W?Jy!ctJw^LUU8{Yg zUaEbo-l=`BKCJzqzO4PI{#*M={XyHHPS-c8JL*i^Sy!|My+&K8Ptx|%x6+pAleHFo zindhWT8rr0XubNj+OR%V%j(m#)%r~BD1AHaJUr-jjlP3+ojzN;N#9Ys1<$hGrO(m+ zsL$2z(|6V$(0A3I(09|G*Z0sq((AO(^?L0ay+Qj)Z`2&dd~K$&P}|4YQ)@Ez(%OwB z+A=)47BQN%j1kasM!UA!=+KTfg4zj2NIS*o)Xp)&+NDNBy9rMM-EAz_{$#As?l%t9 z))@zBuNwzz9~*~ipBho^OXD!@J0qt3Z1if(?9((8k64)lT8%lVO*IeK>dci|yP4L) zW=1>I%xk^oh?X!{X(@BHmNrMV5%UObwRxm=w0V?vf_b!ds(GDuhIzgA8}kP3TJuKj zPv%Y9Bj(52og1`f=g-;!&W&0-jx{cGI`oKB(_>CuKip~R$2y(*iB6Y(nzKwl+v(OX za9a8u&I<1Vkh#^uvbcD3rKxZ3p7Tz>rw*HZl~S3qCuYS+(mb?6tm zg8C({kbZ@$Q@`5PrC;k>u3zu!)^Bq4=)ZFvsNdo`NWax}sD8UEs^8%n(C>B)>i4(~ z*Y9<$)bDqt^aovO{b5%|f5bJcKj!+C{)8*5|J{|-pLLDsFSu6eFS%Chuey%V|LHnX zf6H~0{*LQt{XN&Q`UkFY{bSd0`lopC>ND4g`WLQ~^eSaKBMef zeP-F8^&QIY*XNWypzl%kpzbMqSnnuXrzgrD(bHvr)sHB9Oh2LQas8~azviEt@{Ukiu*@>TlY`;H22T?4EIKT zmYW%~-HI^>FIC#btsA?$okpG8Wi+_UjQMW2vCv&^?CGvB_I6hq`?{+QkGsb3x+fVe z?yZbAcdZd{Pcb^&TN@$wwnoG~)mY)4X7sqH8wa^(8d3LlMhpi)``kMi1MbNLVy}&rtz0mlzdr#wZ z_g=;s?k3}Gce8P>+h?5TZZR%&w;C6_{l=y41B@%&OO31D0pnVCyK$pCWZdiy8^3o) zj9c7Y#%=E9#vSf%;}7m0oFr|J#OT!CyiCsQ^soR zCF4lzW#bs@RpVHE^z?Y^bz_b7Pva!(P2*JSE#q|SZR0HKU&cAsd&c?JhsK50N5;k0 z$Ht}BC&uO0r^Z#*XT~+w=f<_xm&T3OSH{iOzm4BpUmLer-x_yV-x+sV-y3&ZKN4!~Bb-n~z$C`M718f3uwCla|Z;yX7{Yu`KghtK59fsxn`&s?C?J z8uK-4lKHw-YyQ)kV!ml@XTD?2GT*m$Fh8*HVO48KbGX_lAoV^)^$Yu1$SXHG8P->fZf zGPf>oHn%B1)SO-(HD{F{X3i^*nR}P_nQi59Gg{tn4wes?`SPTBbot@tspTp2obn;_ zw(^X5M|swKqC985QohQ3r+l?(RE(L$iR9s|wD=sz@6_=aI ziYv@i#g%5Z;wp2j;%ale;u`bhir<=NR@`8&t+>%Vui_^2l8XN_udcY+yt(3c=3N!P zHy^0D!(3N!r}=2bUFI_te=ut*?>4uoeA1j=`II@U@@aF&%4f`dDxWpImCu=NmCu`p zR=!~NSH5J9RlaKey7D!1ZRP9c`IT>&H&_1Cyrc3h^RJcfm@ienYra|ep7~DY`{oao zADE7+kIczc>&>02J~el(`rKSn^@SO$`oSEm`q4~P{bUYT{cIjtwb4ATiaAfLQkV_5#;bR74pz@`4p+~0=BsycuCCtAd2;pc&U35xa9&nj z=e(i1-g#?vgY(Yn#m>8{_jW#9y^r(N>iwPXRWETmYP`2Y3DbD;B&H3vH%s0qT34Z&wy#^`+} zPT1xa{MAatWNP4jO@`Gy1$O#2u&<}XzMcj9dJ*i>{a}|;wAl-fstrEXQutII*d6VJ z725^RYB?;~9(bb%!>E@Ve5lw1;upE{kYh4xZL(SlCCvsy!Os z`8XmwCm@n{61=ZdVC9|)%lmYAtY^YwKMT>lwQLT&*}3p!=W#FgGI(fL!jr!mUfOTj zQ-}cm9TC8%5#f6V9_#an;Ju){j_BNnI34pDPICOr-cYc23vcT!r9pXH*$ZA+lky(k z;rOA_4vV;7`9%4ZvR)a3S9YB8m9j?pw{p7jwelNS%4?PHm5br2T@H)+X=MZaxSy3* zU^#!TD2{Ixdhhi4;Nb<})xF@uec?PyeKYX7z z5XpZN(S*0)@4O8jz6Y*zX!1E-m0p3}{D&Sot>;SxLp$yzY{D+6- z84knXKL;YGJ1T^e6rEOC;Co2sh2SEq(Q>OlST;>Pv%RQ`nW*C)R%=4roJpH zg6Vkx2EU)u9hetqQ3Qs=E}UXMTEb;GojeAZsKmosIFYj{ZTm@_MBDxnCfb%rm}v7z zm}qN~Fwxd5VHyjZL*!#kH25T32^v-S`1|0TbuB1RF$XSm9KRWV{IWdJaDaq~hNTiF z8Uhj~nQ50W$xMfYNoIl)CYcFIm}p)mVWP8B!Xz_c2~%Gp5+?e)Bs?87(`jFZILJ&; zPp`pv2GOwXIgGP1h;Zx(DbUcPHI4ztro25!;-P*WEMe-`Arhv3;cPDF8_^k+Fwt|E zgo);ugo(CZ3GW6PbV%p{(9U%n-Wex9A1~o8J>l9f%aa@qNSNpulrYhglrYhAxP*zG zl@cair6f$W4M~{jNlTb`o{{iABx{gp`gTYYXrq^ty^mcgA1J0bdyOi)DhKfNM(hsM zZYGl>5)aY2O2S0vY6%maqY@@M$0SU&9U)<&?MMmJI&DHyJUH_i#+aIrpbeNWn~vA9 zvOMv8T*8F^I0+LC$4i*x@B|4{-`7Z(cy*$LiH4IT+z%;nLb8bR!vQ(5dW_+=J73*Pu^S_dt9(;|=8)@X(2MuH1YL?b9Qk2jlx0+XHq3 zJ_Mi8sC1mk(+|a0G-?s;r7}@`NMo{u55u=KrU0h*=Ed+ijn7N?PyISi(oA#edSA!F2M%v4T zJ^FQ6y?;PoTv)e%2irtfsLZuE4SFUsp=Di&SHJG~7ovJ9;Op4~Y79|l!hZw4&9E=l zF)Du}KF>fWuBok?@P&rsablR@|H4NadSNdSo}00&J*Ld!>A%CL8dk$bBAma+*BUC6 zxg6(znm-v2q+5ukQ&#pfLEXA3yackvm3 z^*BL5IB&z(9TIFGr3~=x_`t(!*jXi5~eYIplBQ)lrW9^LlQn(F|n(&Qh`QN*MNRJ)~EEU^OTc7 z1D+7XX|*3q+M+r2S6P>2?9n2ek4czh=5YyMtGFQrrvd*D>=q864lC^uyfa)!`Weat z*l~FPeRSiT;4n^Q7tdwF|FpzI?f#>vt!E@$T%L5}b46vImoUA?xg2{mc%oIA=Wqj_ z~frCE-s;m=FV#pC(-u0g!@sx0(+-r z==I?a2jDQy8U$F%L91p2XA(o$!KU;s$FNe*e#PPCj;pYHTTFj3OgjHviT?(aufiDx z+WotU!{<4!gub}hK~L(PkG=7BJP|`>E^zpjy>ObH;0qlmC`(H46V6X0PSU;WB~0@0 zsf2ff!BovA<2siKxK^DDe@MVn)I}UtQD$qk1(sNyO7J%75Y9t1st&;0s@K6%SfJ8V zf>YJE*=#(8MmVQo-!~=U>1tN#lkg1ndH5*{dHGu%YaKY}!{OT;UpeZrgG_jCcg$Al zQ(g2oVUKN)FsI&EvhjO@8&0uwkqShqVrrrYUH_Frf>eKKz4g;_7?3P-q>|N5A zV%n%Ll|}SaN%&*%b~0N7%;m~@;GE1(RLik@`6*97Nxcy(;^#d5Wc4Ry8vBB$pQ3K< z2;j64)jd^>JHj|gPIXUH|Kg}*-*EVJ^*O-ba`+7OUx2>@omgemFCA0aj~qTrEmvo< zpH&U%&#SwtOYr0$!M{;c7?X5w)n&%^tWL84pQq-G&)7a1(RsewYwm(4e+a%nJ;U6WE#YM@R3A5IDgljX zyGZ@exrhZdC*X_K?Obs@9b^K2QC;Jjk2Qnfm(;sm`>_OvUsk_y?S}VeS0Mcob%(M? z*%2JirRv9Jb8*^=%D>0fD;jW$i~4nyx~`%Jr}N7J zU#(8BT#8Te5&mn`!Ky(#wM1_d{jK_R)w%2?O$U6f8n1S4w!ZHxWn%+y;zflR1q-La z2z~<`!*jg43izMebT$i5DpLBJ+J4aL28Z9$+5kIwnYXo0wj*;Q{Yi*Y=@F`(!G93&)&KdGh#2eWb?3M(chlh?y%j2m*vI%3tpOs>aUPXKE26bKm9RQ4)J8Q zlRb$1fOQIKbL6{lZV%6W*Wei)!1N^b^_W8^>FdxMJynf05`0_lcmhB4R5hL~!TlpD z`C9aUIivPh^58TKQcG-B9A#hV^s5786S^f#FukNbyeYLs1gom#w`gyBrp z{wPmRRZqbSE*N%z+rVk6vo+q@Kzv_{dwQyR8-{l+usQp0Bk>8ZcNw_lfDhFPE~v23 z=+ko=;ws02YMtek0C;O)T|OB6HQ6*rD|qR|DY|vwp^ME?Z-)g`#$M452G87h5h8sL z$-=2ZoV37yHOATCO$EEg*baTJVhJ9J>t6-17XGKf#nh8-J^26)x!cikmv5=$^ z9N*O#r$|EWp@biDz6;XP{tnc>M-jh1`HQjQ>4?qXm%%`03+n{ki#&q9+78rhy{7PYZz^c=TPis7sN%x-wuTD zIPxhb$`Qj+4yYzUGl)MMzxZ_)=s_VBq9y1!v4+jNoA3~eNYXe|XrCqm@PazL3|pXO zGo~vrtxQ(?0QGB$?3c#oJ!az(?;+uIaxH{%_?>5hiLxEC0cQLRL53{N(3P1K&6>BB zov*O%DF0tr*MFk9TuQofVTJM9)_E}|*QVSwpR;3+NFhjj4qHx$`R@KXPCxx-~S zdmMjhyfd=gjJFlM`?`_UenI`>pOPw!PF~#L{dUF7qMFThEdu0!XNbZbp6t_|&AH{f3miU1rjh!s<{8IjDGJjqj zjA^QZxzU6xaPWCkTn~aoc*pTA2Ao6TL8T{@4oPY8EkWbHc(O)rs*{_3X zUR*7*OY+e$wV$K>>$Z?z%$J+CkY7yy@3)X&T>mzizXSF6#6Pfk8JmA9q~4zYe<-0( z)(4rB;N6P98E3`*+6q4zS{|5`1%j0{xv!Tv{jb z+4=}`$6@O^dSxrhEg|jq*e2y>JVkhWS?x1K$5U9{ChBbz^-xQEij=CBDeoHqrCuFO;vqK8g67@dK4lu-c7O{yjFs ziH!n83v0JhasPqT7e+yEaDHMw71JTtfpM}*=yl}uXO}Da#k#`pi++po?2mfW9#WT3 zFTWuq_^VwP3}wSCVw3KyOQd`?cjfS z(I(_*b)kQhOtvY?;m3)SWTKpEuZxz3rTb{6mTO)F!kJp3jnl%YR%$LnQrthzryYQ%)EpDHzXZo}A2`+Ab7nwif0BxKxJW)_A z|KFpXbMY!K)UK1|YL~&W!CBB^d?s*$9wa#tGs6x3it{((e%kLS_PI#e^Oy3MQ~#ZK zN{3fxGcM2+ivQJiQG1@v+q(u16UsN+bgiIrK1Ik4zNP(J@DH)U+Jh9a+#0a00%}bHQp%w<|zj5XHCw9s9`RhB8FYGMd-YA?y zl<$%FYL6s5%L?UdPpA8XlzEp;;Jw4ft8Xjk0bbXA8=OPL34tuZ;<8=X6UFpXtLWd( z&?Cx#-5y_;ApgbVdlbq&r9=9ii29)t{%Y@oF@>|wc7IEMZ9Ot!=ak?hd3i+V^0G?e zoACnSyNA`jNWY^3FV=lqPYe7KFVgLMY_adm#`kAyXwwFNchdB_3%Yrne@W|)$j2H2 z6><+5HFvhy3bPG z=cw-UROkh|yhxXqaI77>{eCw73Y8;!X8bim@H+Nwu#LNv;S9iDq^?o-EyD6Pm3yCZ zKcL(XNws`LxgXQz6S}NNk?~In`kD%VgTmwAB6@@%WjmULj>V=ua$mt^{8fV9QBFWm zkf8VI@;+TYpv#AJ`3RTsj|uujS;NNHE93A3N%VH6m3bG$1lg_#NV45%q1fG_v++F~ zkd&2FBt=DrP-Hw!MaGb^1j%gt2*W14Y3BmV_<7X$6NL0hy1e9ggN=Xhcn5PvtzhFOE_g!> zsy#!OXX)}BR*WT}6T?Gm#S3(KkuERM*c$Zkwse_FmuYmF zu5E*zWo^1LK9fFjum=^cqf0$q8tBqUm-%#AK$nGdSwxq`xGbSgB4`4F_M*$)blHb4 z`_g4Uy6lh3_!5G=RLw`17P_=*J1VSAo2QKXwcQlfiAQ7bY~lXOc!Ub~P>}<189#__ z2f!sZNGd0Zz!5tfN@{#1X`%}$<08tqm@+P*j7urw7OHzIp1onuLM<&pDU6JcwC8bI zJKInH-f=7;-x`0nZ`j{`*J1o0TM{~X>vwAw{BY*?`}>dCdF|D&R6h3Y{>}Ywd^v;< zhZ#%SWExxYSH6xmTYXuPHv#&ej=8a6%G6fx6H=W=?ixS zB4JK^dn}m_WHQ4noR4Mm?Xi5{Ao`ph2`5sCzI-y1<}`$2Be_I7lF``-xTs1J{#hUP zEQ_;?TJ9(MaxB)H$>tMr)<2wMoT5Z3Hk?C(Xt&)HX>OA&<=hrTuxuR=)k$A}NbhFg%73nX(83VG9<8NuL% z`(o*qOtxJnZh?Kph}%8gQG8M{+TsuR!mI@t;<6^jCuYNKqSeh)Ftn^dTQW| zTq2gm@X3362-jvuGCqpI5d%`f3Y#((@GbWRCRjmY!N+@ZStw+Q5ic6$LQcEK-_h>t z=;C~B0sn#{c`iquREjg7-=N#9DHZEmiQG^umB{DC{AmT-AzJy7ToW?mSqNuSDwz)t zXOsB^n4N;a&^!aO5M(ylhhf2tjVJt4SouT|7?2~Tq(nqFU4AiL2UXUYA9J zki}rMn}s8uNLM)8!&-eEzD`d7Nv)lpkS`1%lZppuN|NZ0WV09w^oY;7Q5H{P2bSg_ z%MXqW^+wPUe>$ERW%*G#d&O;TWpbG1$7C8?6-$jIFm9Rt{#+u@lDtY%{ubIx%5pi3 zX~fqZ0eQJZUnU*TK^+Vw(<6CwTc*_4v3v%~EG!EQCFAi_f~d@OgK*5-dQ>T-^y%zB50fnzv1nnPKl2ZJ96qvWuvw{mxYa$=985qhW)A{C1CX0T0Grn{_nNKEi zL1=Gi5r&b&TxiW^p#BEQq9NgzOr`4`jhLN?dlS7Q{rwRdq8w*(X%c2nX9ANX+meb6uv}jzn~)5a65!8qIf1y+!X0P! zeMs_Sc`TL0@{?JW5apP!BjS(rL|Z!j%@KdFgT=52u1eTFpJ0-$d29}e@$hC6vO!xc zvF0Z71vwJK&c_;HFQ|stY?3PmUXmkj3ME(wbS;f`dc6LwFbhfPu!WxE6(c64q!dd* z`6jb+(1RBKai9whcvXO`f z{SI}7+oBw;kg=sCh`iUq)y$q}d^UjMt~6|xxIIo{E`$^L;`tYD4tDyYU7^jGfTksH zL=aCEi7_i8zx#F)F5Zi9#z%FIf(Y(!swp zj76?mi;_v52z^_eC{-0D@$Snup-x1pB=bo-L#zybpKzPVZ{$XlCmk1tX^u&|(zctZ zh<^x!|1QH(N7TCo&>RgsKc)RWD^65Ql&)3uyx z(3HWiDDTe!oUoNZfQhS;%g_P!#0(J0rYISQf&}6f2CFpLP|= zD~wC07$M>07T5Q6cv+G-L3PH6JJNaGggru~6f_B6G@wqfgu^W=Rw@)l*u;ziQqFo> zN90;Ui-*0CjOO`5GKL?qdI{C#hf*8Dc;km=0TjxA>}4KCI_W{uR*_E3bm~ivgi_4; zHlGK44MxQ;_-orH9lovz`G&-EHo&J9ln{A_qy#%*0{NB+Srir;)^B797nA#M&A~vh zlVPx0eUWGjRAV(62M=X! zAzj*Cn^!1pjo;Z(1lSdV7%t2*lEO=H1t)7#h>3%?e&aXGXdc+Ee*)u%V%*ZfVgnaM zGE~kF)&z5q>{D=8r~|=vq4o;~np~e6uq<((yG{9HgBFj!JSqZB@h(^7GX?#R&+$0 z+dLi31tI%|s_i^tm$MhQiLRG$*d9ePqKk;ift|TQv3^M*v*naxEp`$|RXoOGNVd%E zQfy)Zgt-~OU>b17%dV7;Mp5@Ug~655B zMI|8H9Z-K0BWv?#A_aBQc^LSJ29FhLN_naml1=`xK;1BrFfrpXkqeW26TW9wPoU(? z<-*UQ;+bPpRXUTCIVw029207{pc;e^vboAA9Tz!*o3e7tSbCtxXf+`VE<6~^!hQ|6 zc{+Vw9-`rPPD@K9!~F0U{T&fsXTaxK4qp=Y!IgCF$mDsTlVE?)m(6Cf1UALu6jPlj zClo?)DT$nt;E}d?5Vzi>W-;z)S4VTOJp>CsjOLr#+q_Y~mxY?z>8F{j3;e?0hXQIQ z6AE|XRjMi6(1r`royK-65pLtkwo4i+H0H$pMVWS)cs##MU^VLXIrEw)(VWTIU^rPwoj}E1qX@h&UMhzgL##bN+Sn+NA{0b6iPzUkP2h*_kVtn;{*KM_ zkSK_W2A5;?tY2Jb)6GNck-;Q_>4mxylWc|RhU~_(*zm!Y4t0~O;iW}Md)5`* z%wJG+!wZW36s0yUEUwU4UtFVMQE^^FLvbE)vWV)&1$dB8hz4tKY>d{|^PdLsQ{TYv z8fBumt8WyE;;up7H5OrQT(BqfPMXV>5GI==BmhODPb}vQ=Q6q?mV^Sv-XZ+K_E>f$ z0notkKm^pBf?p^=eifEYG*87^vWZ_wJGMCx*_DYnf_jB)66}FQ7D-Ut?Vb*=Kv=Yj!U%x*#q(GYPKdvQ zTiOM?T2Sdv=dj5^J43wHHU!dB)T&JewsjNP?8q?MfmPMv3q9rLmNrG(gWhN}yp|}9 z7td?uSAh!QA;gY}6hFTnKy*<2JjZWE1q!N#0#1x@z|$Juq&J;ByMbQ`&qR+z zzZ!XtXm&n_$wwt3xh#mymF@KuOVWTd-Y97W5P) zlu8qcFi(b`0tbZ`pc!iS5mq!94hxKOc+YsqpYFWAfDh_}K-iRC0hM%;vj?$Jk+Ln>sP6+PzWIM*;M$R0EQTP=#!q42>1!Ju$I$AX2G@R7xTl6F=FXOk_njCpgBN zDJa&GDtt&0Zv-yXqJn^mh9oglKg=fS8x=c?#2 z-Evft2$<^7p(u^Uc~5O6%SrKiA|87&NXJD1Vg*;h;&ws@7l4 zV$r59geyB(^GG(A$%@b~wiB`Q)HH%Hd76bva+e1kJ;drKlQ z(i8GUsjES(GuY@(rR+L#7SN#3Jf~1Ax<^_~N-}G2$Ds&Zdg$U!r1CL-%ORd7SOR~k zi3&DR!KSF>6CjDwpB^5`3lS_K6vw0BQsx9bG-`;R!g-5hCT?1T_d>ES$hUDzFm*x+ zdB{U7>a!?qk7f!dX=KOk7JWm*h;H&kNhm1^L8m_lu5==tg!2P*oD6|^ekH$>+Z6mR z$D-0jiYBN`uDBC23o|i`%6x!ie2cr?GTVp!PO2sG6%VRSXE9PcP0(I6n*Wh>P8{C- z(dw1W03d=y6x5R*<4$|afeAV&*Br|tY}x~ULG05oI=u*_w`E3fi_Hz3Izd8SY+3dX zae8q+Ael-rPd<+zC|RW3>Fl7riZIah4R%tcB#ubHamBGO{7@$Sk{S!9Q)9r8j&~#w z_7(FPO~(@qULr>o$|hIQSr6Qk$A=$c8{Gj#a5#}}8AYZPV^)E3?&HP zj(4CXnT4P08^zI-ENjCV92^$(W^y7t0+U)61uGCXpc5pXZr0Szn!A}7K!}C?2*WdP zm?2UvmU~ZtdD>W0fHk$T<^W7x<_$1!8~8SWV{5e7w9vVP{#0f)YY8U@(k1*u*Gl+T z$^+^#b-u+jGMY>!V?+-Iiw;Nh4}q1`VNlP&{d9f>4(afdJm?w%A^6Tkhz<$$3O@EB zhJ+UpQ&gpJyeQNH>49&P$q~?u5UHQP#3{=tV_b2HiChWey|c#sG{hc+ek0g=6;@OAMKF^2Kv12g0Y%a-I6{-k2 zLN>bzdw~~RB!nag@gR4vfTNRdESIz@1_h<)RG;jqjTxtiGJUeIkWkK#31mVlno~K* zJoq<}VfU9ao=*ND3?@ke7A^`LV0x@{4VTa~l}00XYmV+#UY z%)%N^Biau=HVo5@c7)J|-IL-eF+pgP*j`5=DH_E430B5ZwlpBw7AgVS@{W2)kP^jd z5d+Ibg8ZqdC*Y^`uie*PIvMzG6ZgiK55)M+u$-~LXE$3i9pyOCngbCW9!&P-gh^hw zE22_}2(L;6bnwj@a@}K8djT_<6(}KeI*z3BFUaq*bs6 z)7lcBtqF4ez>)VVHX=Q>^Nkq zn<2C>7(=%`Jn}5nA_b3yLK-YNLyNOB{CuetvmSodqz{S(ClqB>c_(Vi8#Fb@@{ma~ zXXuy73>^O*j`hhc1j-Orq@b##Y1v{o*ogB#90ecKQ6kCSIFs~F)Antec-C-4F# z^-%i%ycTtV$O9L$eUfc}gd_my7KYP=PC*)V2|qm|YyL#{I3n3^-d{@SmTdZEuB;~0 zZ1FELhnm_FGkLZ7|J!Q3^h7rbL-POE_9Ip`4sM@CkF=j6GyZ`OJ^b3kZ{f8*ptcP@K1k#6TfyA5K>wzW+^Yt3uQ2i zWOJlu`1BL%M3#zE32K^WZBnLSp%y))g2RENa9h2tICh9@OE(WlU>U>KN{BoKv8RY- zgyfjE3dzXgE`)vK<#+9gAu^;GN(M1^$r9l^6(O9bhi5_#XCaN_5s1+ec4p8VUGU+d zWFA{8$vi%0oy=ncCz)T!Ca5SN5J<6Yg#wG{vY0M=vSF-t8PXh}Rjxk1QFtjJyU-lM zsVIwJDqR~`R~qVhrPu?d6m0AyhPV?WtmXiFi*z0dX&zNz`fxs5G4w_MmUX$IQIbidDtw+x5jZGzc+*DOmJ|! zDJX^x+k^GAN7z7@x+r$R@Y_h2`E=p83kj+h`*}QT5hXMfCDcV1@sf)vV^3bZj;@Uy zZ9PY@kRz;bKpFUth#UaL0-jSRNI>h9SSOmt;RCs~!qa%=IzdleR9543c>T+xzRpe@ zx@t*fV);l0=mj25O`V{pB@px!5KfdsNg@V&y8dpTS8QlDLt^2K;VRrm?%$LojM)$M zh=a89z+1_3L(_v$&`-cG5F;Y(@4((J9W8^s?pf~f2k6X^0K~bIOxBO3jbykNqeW4Y z6c-{Ej;+E&QTe($5$%9Wz=Er?INdM|5#nJB_#*>Ni%~$P(|opTHQ0&4>;Qqy2(s|U z-|$2uPMu>;%aYjBlu&&W9K1w-a+GFrAd?=TQuNCSlZ6^RHexPp-pmMg!fgzVO*Vx6 zPkI6~l+7UM0KLYWZi%Jvh>ne@*@hbCV_$RBZV+8gU{le~Y{V%K!HCBB)G{e4j;x?! zN~rS{N-rSpc^c0e8EJmIAbpGnc9p`8-@E6$TDu zz!R}+;C*x=e8S_HbTqDSWgt0(<8bH``a)4K_?)r}iwSF8-TXSn14TG&fS}f@tZyhM zV_}gj76Ke4pnZ8+2@}n(j){gq4v&`+cWF%V^r;XCpg{!3Mg!HbxNh-6M#n 0 then + WriteLn('Cause: ', message); + + Halt(1); +end; + +procedure LoadEverything; +var + s : string[32]; +begin + UseLayer(SCREEN_LAYER); + + s := 'Loading 1/4 ...'; + Cls(0); + DrawString(100, 96, 15, s); + + if LoadFont('dp.fnt', @fnt) <> FontOk then + FatalExit('Failed loading font dp.fnt'); + + s := 'Loading 2/4 ...'; + Cls(0); + DrawString(100, 96, 15, s); + + if LoadFont('chunky.fnt', @chunkyFnt) <> FontOk then + FatalExit('Failed loading font chunky.fnt'); + + s := 'Loading 3/4 ...'; + Cls(0); + DrawString(100, 96, 15, s); + + if (not LoadTilesAndSprites('tiles.lbm')) then + FatalExit('Failed loading graphics tiles.lbm'); + + s := 'Loading 4/4 ...'; + Cls(0); + DrawString(100, 96, 15, s); + + if (not LoadImages('images.lbm')) then + FatalExit('Failed loading images images.lbm'); + + FadeOut; + + Cls(0); + SetPalette(@pal); +end; + +procedure DoIntro; +begin + UseLayer(SCREEN_LAYER); + UseFont(@fnt); + + Cls(0); + BlackOutPalette; + WaitForTime(500); + + DrawString(50, 96, 15, '... a GDR 4x4x4 Challenge Entry ...'); + FadeIn; + WaitForTime(2000); + FadeOut; + + WaitForTime(500); + + Cls(0); + DrawString(50, 96, 15, '... created despite much slacking ...'); + FadeIn; + WaitForTime(2000); + FadeOut; + + WaitForTime(500); + Cls(0); +end; + +begin + Randomize; + InitGraphics(2); + InitKeyboard; + InitTimer(TIMER_FREQ); + InitTrigTablesFP; + + LoadEverything; + DoIntro; + + currentGameState := StateMainMenu; + + while currentGameState <> StateQuit do begin + case currentGameState of + StateMainMenu: DoMainMenu; + StateLevelSelect: DoLevelSelect; + StateFruitSelect: DoFruitSelect; + StateHelp: DoHelp; + StateMatch: begin + StartMatch; + MainLoop; + end; + StateResults: DoResults; + end; + end; + + CloseEvents; + CloseTimer; + CloseKeyboard; + CloseGraphics; +end. diff --git a/FRUITSEL.PAS b/FRUITSEL.PAS new file mode 100644 index 0000000..46a14b3 --- /dev/null +++ b/FRUITSEL.PAS @@ -0,0 +1,127 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit FruitSel; + +interface + +procedure DoFruitSelect; + +implementation + +uses GDGfx, GDKeybrd, GDTimer, GDEvents, Assets, Draw, Entities, Shared; + +var + randomSelection : integer; + +procedure DrawFruitSelect; +var + uiFrame : ^UIFrameBitmaps; + playerTile, fruitTile : word; +begin + Cls(0); + + BlitSpritef(29, 10, titleChooseFruit); + + UseFont(@fnt); + if randomSelection = -1 then + DrawString(62, 60, 15, 'Choosing by random selection ...') + else + DrawString(92, 60, 15, 'Fruit has been chosen!'); + + if randomSelection = -1 then begin + DrawUIFrame(60, 90, 64, 64, uiGeneralFrame); + DrawString(68, 98, 15, 'Player 1'); + BlitSpritef(72, 122, sprites[PLAYER_NEUTRAL_TILE]); + + DrawUIFrame(196, 90, 64, 64, uiGeneralFrame); + DrawString(204, 98, 15, 'Player 2'); + BlitSpritef(208, 122, sprites[PLAYER_NEUTRAL_TILE]); + end else begin + if player1Selection = Tomato then begin + uiFrame := @uiTomatoFrame; + playerTile := PLAYER_TOMATO_TILE_START; + fruitTile := FRUIT_TOMATO_TILE_START; + end else begin + uiFrame := @uiGrapesFrame; + playerTile := PLAYER_GRAPES_TILE_START; + fruitTile := FRUIT_GRAPES_TILE_START; + end; + + DrawUIFrame(60, 90, 64, 64, uiFrame^); + DrawString(68, 98, 15, 'Player 1'); + BlitSpritef(72, 122, sprites[playerTile]); + BlitSpritef(72+16+8, 122, sprites[fruitTile]); + + if player2Selection = Tomato then begin + uiFrame := @uiTomatoFrame; + playerTile := PLAYER_TOMATO_TILE_START; + fruitTile := FRUIT_TOMATO_TILE_START; + end else begin + uiFrame := @uiGrapesFrame; + playerTile := PLAYER_GRAPES_TILE_START; + fruitTile := FRUIT_GRAPES_TILE_START; + end; + + DrawUIFrame(196, 90, 64, 64, uiFrame^); + DrawString(204, 98, 15, 'Player 2'); + BlitSpritef(208, 122, sprites[playerTile]); + BlitSpritef(208+16+8, 122, sprites[fruitTile]); + end; + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +procedure DoFruitSelect; +var + quit : boolean; + aborted : boolean; + event : PInputEvent; +begin + UseLayer(BACKBUFFER_LAYER); + + randomSelection := -1; + + DrawFruitSelect; + FadeIn; + InitEvents; + + quit := false; + aborted := false; + while not quit do begin + while not IsEventsEmpty do begin + event := PollEvents; + + if IsKeyReleasedEvent(event, KEY_ESC) then begin + quit := true; + aborted := true; + end; + + if IsKeyReleasedEvent(event, KEY_ENTER) then begin + if randomSelection = -1 then begin + randomSelection := random(2); + if randomSelection = 0 then begin + player1Selection := Tomato; + player2Selection := Grapes; + end else begin + player1Selection := Grapes; + player2Selection := Tomato; + end; + end else + quit := true; + end; + end; + + DrawFruitSelect; + end; + + CloseEvents; + FadeOut; + + if (aborted) or (randomSelection = -1) then + currentGameState := StateMainMenu + else + currentGameState := StateMatch; +end; + +end. diff --git a/GDLIB/FIXEDP.PAS b/GDLIB/FIXEDP.PAS new file mode 100644 index 0000000..e3de53e --- /dev/null +++ b/GDLIB/FIXEDP.PAS @@ -0,0 +1,193 @@ +{ Fixed-point math type definition, constants and functions. + Gered King, 2019-2020 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit FixedP; + +interface + +const + FP_INT_SHIFT = 16; + FP_FLOAT_SHIFT = 65536.0; + + FP_DIV_ERROR = $7fffffff; + + FP_1 = trunc(1 * FP_FLOAT_SHIFT); + FP_2 = trunc(2 * FP_FLOAT_SHIFT); + FP_3 = trunc(3 * FP_FLOAT_SHIFT); + FP_4 = trunc(4 * FP_FLOAT_SHIFT); + FP_5 = trunc(5 * FP_FLOAT_SHIFT); + FP_6 = trunc(6 * FP_FLOAT_SHIFT); + FP_7 = trunc(7 * FP_FLOAT_SHIFT); + FP_8 = trunc(8 * FP_FLOAT_SHIFT); + FP_9 = trunc(9 * FP_FLOAT_SHIFT); + FP_10 = trunc(10 * FP_FLOAT_SHIFT); + + FP_16 = trunc(16 * FP_FLOAT_SHIFT); + FP_32 = trunc(32 * FP_FLOAT_SHIFT); + FP_64 = trunc(64 * FP_FLOAT_SHIFT); + FP_128 = trunc(128 * FP_FLOAT_SHIFT); + FP_256 = trunc(256 * FP_FLOAT_SHIFT); + + FP_0_1 = trunc(0.1 * FP_FLOAT_SHIFT); + FP_0_2 = trunc(0.2 * FP_FLOAT_SHIFT); + FP_0_3 = trunc(0.3 * FP_FLOAT_SHIFT); + FP_0_4 = trunc(0.4 * FP_FLOAT_SHIFT); + FP_0_5 = trunc(0.5 * FP_FLOAT_SHIFT); + FP_0_6 = trunc(0.6 * FP_FLOAT_SHIFT); + FP_0_7 = trunc(0.7 * FP_FLOAT_SHIFT); + FP_0_8 = trunc(0.8 * FP_FLOAT_SHIFT); + FP_0_9 = trunc(0.9 * FP_FLOAT_SHIFT); + + FP_0_25 = trunc(0.25 * FP_FLOAT_SHIFT); + FP_0_75 = trunc(0.75 * FP_FLOAT_SHIFT); + + FP_1_OVER_3 = trunc((1 / 3) * FP_FLOAT_SHIFT); + FP_2_OVER_3 = trunc((2 / 3) * FP_FLOAT_SHIFT); + +type + Fixed = LongInt; + +{ turbo pascal's "inline" used here solely for functions that we want to be + inlined for best performance. in c/c++, these would've been written + as macros, but turbo pascal unfortunately lacks macro support. so we + are using "inline" as a poor way to get a sort of function inlining... } + +function IntToFix(x : integer) : fixed; +inline( + $58/ { pop ax } + $8B/$D0/ { mov dx, ax } + $33/$C0 { xor ax, ax } +); +function FixToInt(x : fixed) : integer; +inline( + $66/$58/ { pop eax } + $66/$C1/$E8/FP_INT_SHIFT { shr eax, FP_INT_SHIFT } +); + +function FloatToFix(x : single) : fixed; + +function FixToFloat(x : fixed) : single; + +function FixMul(a, b : fixed) : fixed; +inline( + $66/$5B/ { pop ebx } + $66/$58/ { pop eax } + $66/$F7/$EB/ { imul ebx } + $66/$0F/$AC/$D0/FP_INT_SHIFT/ { shrd eax, edx, FP_INT_SHIFT } + $66/$C1/$C0/FP_INT_SHIFT/ { rol eax, FP_INT_SHIFT } + $8B/$D0/ { mov dx, ax } + $66/$C1/$C0/FP_INT_SHIFT { rol eax, FP_INT_SHIFT } +); + +function FixDiv(a, b : fixed) : fixed; +inline( + $66/$5B/ { pop ebx } + $66/$58/ { pop eax } + $66/$33/$C9/ { xor ecx, ecx } + $66/$0B/$C0/ { or eax, eax } + $79/$05/ { jns checkDivisorSign } + $66/$F7/$D8/ { neg eax } + $66/$41/ { inc ecx } + { checkDivisorSign: } + $66/$0B/$DB/ { or ebx, ebx } + $79/$05/ { jns divide } + $66/$F7/$DB/ { neg ebx } + $66/$41/ { inc ecx } + { divide: } + $66/$33/$D2/ { xor edx, edx } + $66/$0F/$A4/$C2/FP_INT_SHIFT/ { shld edx, eax, FP_INT_SHIFT } + $66/$C1/$E0/FP_INT_SHIFT/ { shl eax, FP_INT_SHIFT } + $66/$3B/$D3/ { cmp edx, ebx } + $73/$08/ { jae error } + $66/$F7/$F3/ { div ebx } + $66/$0B/$C0/ { or eax, eax } + $79/$08/ { jns restoreSignBit } + { error: } + $66/$B8/$FF/$FF/$FF/$7F/ { mov eax, FP_DIV_ERROR } + $EB/$09/ { jmp done } + { restoreSignBit: } + $66/$83/$F9/$01/ { cmp ecx, 1 } + $75/$03/ { jne done } + $66/$F7/$D8/ { neg eax } + { done: } + $66/$C1/$C0/FP_INT_SHIFT/ { rol eax, FP_INT_SHIFT } + $8B/$D0/ { mov dx, ax } + $66/$C1/$C0/FP_INT_SHIFT { rol eax, FP_INT_SHIFT } +); + + +function FixDivFast(a, b : fixed) : fixed; +inline( + $66/$5B/ { pop ebx } + $66/$58/ { pop eax } + $66/$99/ { cdq } + $66/$0F/$A4/$C2/FP_INT_SHIFT/ { shld edx, eax, FP_INT_SHIFT } + $66/$C1/$E0/FP_INT_SHIFT/ { shl eax, FP_INT_SHIFT } + $66/$F7/$FB/ { idiv ebx } + $66/$C1/$C0/FP_INT_SHIFT/ { rol eax, FP_INT_SHIFT } + $8B/$D0/ { mov dx, ax } + $66/$C1/$C0/FP_INT_SHIFT { rol eax, FP_INT_SHIFT } +); + +function FixSqr(x : fixed) : fixed; +inline( + $66/$58/ { pop eax } + $66/$F7/$E8/ { imul eax } + $66/$0F/$AC/$D0/FP_INT_SHIFT/ { shrd eax, edx, FP_INT_SHIFT } + $66/$C1/$C0/FP_INT_SHIFT/ { rol eax, FP_INT_SHIFT } + $8B/$D0/ { mov dx, ax } + $66/$C1/$C0/FP_INT_SHIFT { rol eax, FP_INT_SHIFT } +); + +function FixSqrt(x : fixed) : fixed; + +implementation + +function FloatToFix(x : single) : fixed; +begin + FloatToFix := trunc(x * FP_FLOAT_SHIFT); +end; + +function FixToFloat(x : fixed) : single; +begin + FixToFloat := x / FP_FLOAT_SHIFT; +end; + +function FixSqrt(x : fixed) : fixed; +assembler; +asm + db $66; mov bx, x.word { mov ebx, x } + db $66,$b9,$00,$00,$00,$40 { mov ecx, $40000000 } + db $66; xor ax, ax { xor eax, eax } + + @@1: + db $66; mov dx, ax { mov edx, eax } + db $66; add dx, cx { add edx, ecx } + + db $66; cmp bx, dx { cmp ebx, edx } + jl @@2 + db $66; sub bx, dx { sub ebx, edx } + db $66; mov ax, dx { mov eax, edx } + db $66; add ax, cx { add eax, ecx } + @@2: + db $66; shl bx, 1 { shl ebx, 1 } + db $66; shr cx, 1 { shr ecx, 1 } + + db $66; cmp cx, 40h { cmp ecx, $40 } + jg @@1 + + db $66; shr ax, 8 { shr eax, 8 } + + db $66; rol ax, FP_INT_SHIFT { rol eax, FP_INT_SHIFT } + mov dx, ax + db $66; rol ax, FP_INT_SHIFT { rol eax, FP_INT_SHIFT } +end; + +begin + if Test8086 < 2 then begin + writeln('The FIXEDP unit requires a 386 cpu or higher!'); + halt; + end; +end. diff --git a/GDLIB/GDCLIP.PAS b/GDLIB/GDCLIP.PAS new file mode 100644 index 0000000..0487ee3 --- /dev/null +++ b/GDLIB/GDCLIP.PAS @@ -0,0 +1,392 @@ +{ GDlib Coordinate/Region/Screen Clipping Utilities + Gered King, 2018 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDClip; + +interface + +function IsPointInScreen(x, y: integer) : boolean; +function IsPointInClipRegion(x, y: integer) : boolean; +function IsRegionInScreen(x1, y1, x2, y2: integer) : boolean; +function IsRegionInClipRegion(x1, y1, x2, y2: integer) : boolean; +function ClampToScreen(var x1, y1, x2, y2: integer) : boolean; +function ClampToClipRegion(var x1, y1, x2, y2: integer) : boolean; +function ClipToScreen(var x, y, width, height: integer) : boolean; +function ClipToClipRegion(var x, y, width, height: integer) : boolean; +function ClipBlitToScreen(var srcX, srcY, srcWidth, srcHeight, destX, destY: integer) : boolean; +function ClipBlitToClipRegion(var srcX, srcY, srcWidth, srcHeight, destX, destY: integer) : boolean; + +implementation + +uses GDGfx; + +function IsPointInScreen(x, y: integer) : boolean; +{ returns true if the given point is within the screen boundaries } +begin + IsPointInScreen := ((x < SCREEN_LEFT) + or (y < SCREEN_TOP) + or (x > SCREEN_RIGHT) + or (y > SCREEN_BOTTOM)); +end; + +function IsPointInClipRegion(x, y: integer) : boolean; +{ returns true if the given point is within the current clipping region } +begin + IsPointInClipRegion := ((x < ClipRegionLeft) + or (y < ClipRegionTop) + or (x > ClipRegionRight) + or (y > ClipRegionBottom)); +end; + +function IsRegionInScreen(x1, y1, x2, y2: integer) : boolean; +{ returns true if the given region is partially or completely within the + screen boundaries } +begin + IsRegionInScreen := false; + + if (y1 < SCREEN_TOP) and (y2 < SCREEN_TOP) then + exit; + if (y1 > SCREEN_BOTTOM) and (y2 > SCREEN_BOTTOM) then + exit; + if (x1 < SCREEN_LEFT) and (x2 < SCREEN_LEFT) then + exit; + if (x1 > SCREEN_RIGHT) and (x2 > SCREEN_RIGHT) then + exit; + + IsRegionInScreen := true; +end; + +function IsRegionInClipRegion(x1, y1, x2, y2: integer) : boolean; +{ returns true if the given region is partially or completely within the + current clipping region } +begin + IsRegionInClipRegion := false; + + if (y1 < ClipRegionTop) and (y2 < ClipRegionTop) then + exit; + if (y1 > ClipRegionBottom) and (y2 > ClipRegionBottom) then + exit; + if (x1 < ClipRegionLeft) and (x2 < ClipRegionLeft) then + exit; + if (x1 > ClipRegionRight) and (x2 > ClipRegionRight) then + exit; + + IsRegionInClipRegion := true; +end; + +function ClampToScreen(var x1, y1, x2, y2: integer) : boolean; +{ if the given region is visible on screen (either partially or completely) + the coordinates are checked individually against each edge of the screen + and adjusted if need-be to keep them within bounds. if the region is not + visible at all, then nothing is changed and false is returned. } +begin + ClampToScreen := false; + + if (not IsRegionInScreen(x1, y1, x2, y2)) then + exit; + + { we now know the given region is at least partially visible } + ClampToScreen := true; + + if (y1 < SCREEN_TOP) then + y1 := SCREEN_TOP; + if (y1 > SCREEN_BOTTOM) then + y1 := SCREEN_BOTTOM; + if (y2 < SCREEN_TOP) then + y2 := SCREEN_TOP; + if (y2 > SCREEN_BOTTOM) then + y2 := SCREEN_BOTTOM; + if (x1 < SCREEN_LEFT) then + x1 := SCREEN_LEFT; + if (x1 > SCREEN_RIGHT) then + x1 := SCREEN_RIGHT; + if (x2 < SCREEN_LEFT) then + x2 := SCREEN_LEFT; + if (x2 > SCREEN_RIGHT) then + x2 := SCREEN_RIGHT; +end; + +function ClampToClipRegion(var x1, y1, x2, y2: integer) : boolean; +{ if the given region is within the current clipping region (either + partially or completely) the coordinates are checked individually + against each edge of the clipping region and adjusted if need-be to keep + them within bounds. if the region is not visible at all, then nothing is + changed and false is returned. } +begin + ClampToClipRegion := false; + + if (not IsRegionInClipRegion(x1, y1, x2, y2)) then + exit; + + { we now know the given region is at least partially visible } + ClampToClipRegion := true; + + if (y1 < ClipRegionTop) then + y1 := ClipRegionTop; + if (y1 > ClipRegionBottom) then + y1 := ClipRegionBottom; + if (y2 < ClipRegionTop) then + y2 := ClipRegionTop; + if (y2 > ClipRegionBottom) then + y2 := ClipRegionBottom; + if (x1 < ClipRegionLeft) then + x1 := ClipRegionLeft; + if (x1 > ClipRegionRight) then + x1 := ClipRegionRight; + if (x2 < ClipRegionLeft) then + x2 := ClipRegionLeft; + if (x2 > ClipRegionRight) then + x2 := ClipRegionRight; +end; + +function ClipToScreen(var x, y, width, height: integer) : boolean; +{ clips a region to the screen by adjusting the top-left x,y coordinate + and/or the width/height of the region as appropriate. returns false if a + "completely out of bounds" scenario was encountered. returns true if the + region was completely in bounds (no clipping/clamping needed) or if the + region was clipped to the screen and is still partially in bounds. } +var + right, bottom, offset : integer; +begin + ClipToScreen := false; + + right := x + width - 1; + bottom := y + height - 1; + + { off the left edge? } + if x < SCREEN_LEFT then begin + { completely off the left edge? } + if right < SCREEN_LEFT then + exit; + + offset := SCREEN_LEFT - x; + inc(x, offset); + dec(width, offset); + end; + + { off the right edge? } + if x > (SCREEN_WIDTH - width) then begin + { completely off the right edge? } + if x > SCREEN_RIGHT then + exit; + + offset := x + width - SCREEN_WIDTH; + dec(width, offset); + end; + + { off the top edge? } + if y < SCREEN_TOP then begin + { completely off the top edge? } + if bottom < SCREEN_TOP then + exit; + + offset := SCREEN_TOP - y; + inc(y, offset); + dec(height, offset); + end; + + { off the bottom edge? } + if y > (SCREEN_HEIGHT - height) then begin + { completely off the bottom edge? } + if y > SCREEN_BOTTOM then + exit; + + offset := y + height - SCREEN_HEIGHT; + dec(height, offset); + end; + + ClipToScreen := true; +end; + +function ClipToClipRegion(var x, y, width, height: integer) : boolean; +{ clips a region to the current clipping region by adjusting the top-left + x,y coordinate and/or the width/height of the region as appropriate. + returns false if a "completely out of bounds" scenario was encountered. + returns true if the region was completely in bounds (no clipping/clamping + needed) or if the region was clipped to the clipping region and is still + partially in bounds. } +var + right, bottom, offset : integer; +begin + ClipToClipRegion := false; + + right := x + width - 1; + bottom := y + height - 1; + + { off the left edge? } + if x < ClipRegionLeft then begin + { completely off the left edge? } + if right < ClipRegionLeft then + exit; + + offset := ClipRegionLeft - x; + inc(x, offset); + dec(width, offset); + end; + + { off the right edge? } + if (x - ClipRegionLeft) > (ClipRegionWidth - width) then begin + { completely off the right edge? } + if x > ClipRegionRight then + exit; + + offset := (x - ClipRegionLeft) + (width - ClipRegionWidth); + dec(width, offset); + end; + + { off the top edge? } + if y < ClipRegionTop then begin + { completely off the top edge? } + if bottom < ClipRegionTop then + exit; + + offset := ClipRegionTop - y; + inc(y, offset); + dec(height, offset); + end; + + { off the bottom edge? } + if (y - ClipRegionTop) > (ClipRegionHeight - height) then begin + { completely off the bottom edge? } + if y > ClipRegionBottom then + exit; + + offset := (y - ClipRegionTop) + (height - ClipRegionHeight); + dec(height, offset); + end; + + ClipToClipRegion := true; +end; + +function ClipBlitToScreen(var srcX, srcY: integer; + var srcWidth, srcHeight: integer; + var destX, destY: integer) : boolean; +{ clips a source bitmap blit region to the screen by adjusting the source + blit region and the destination x,y coordinate as appropriate. + returns false if a "completely out of bounds" scenario was encountered. + returns true if the region was either completely in bounds (no + clipping/clamping needed), or if the region was clipped to the screen + and is still partially in bounds. } +var + right, bottom, offset : integer; +begin + ClipBlitToScreen := false; + + right := srcX + srcWidth - 1; + bottom := srcY + srcHeight - 1; + + { off the left edge? } + if destX < SCREEN_LEFT then begin + { completely off the left edge? } + if (destX + srcWidth - 1) < SCREEN_LEFT then + exit; + + offset := srcX - destX; + destX := SCREEN_LEFT; + inc(srcX, offset); + dec(srcWidth, offset); + end; + + { off the right edge? } + if destX > (SCREEN_WIDTH - srcWidth) then begin + { completely off the right edge? } + if destX > SCREEN_RIGHT then + exit; + + offset := destX + srcWidth - SCREEN_WIDTH; + dec(srcWidth, offset); + end; + + { off the top edge? } + if destY < SCREEN_TOP then begin + { completely off the top edge? } + if (destY + srcHeight - 1) < SCREEN_TOP then + exit; + + offset := srcY - destY; + destY := SCREEN_TOP; + inc(srcY, offset); + dec(srcHeight, offset); + end; + + { off the bottom edge? } + if destY > (SCREEN_HEIGHT - srcHeight) then begin + { completely off the bottom edge? } + if destY > SCREEN_BOTTOM then + exit; + + offset := destY + srcHeight - SCREEN_HEIGHT; + dec(srcHeight, offset); + end; + + ClipBlitToScreen := true; +end; + +function ClipBlitToClipRegion(var srcX, srcY: integer; + var srcWidth, srcHeight: integer; + var destX, destY: integer) : boolean; +{ clips a source bitmap blit region to the current clipping region by + adjusting the source blit region and the destination x,y coordinate as + appropriate. + returns false if a "completely out of bounds" scenario was encountered. + returns true if the region was either completely in bounds (no + clipping/clamping needed), or if the region was clipped to the clipping + region and is still partially in bounds. } +var + right, bottom, offset : integer; +begin + ClipBlitToClipRegion := false; + + right := srcX + srcWidth - 1; + bottom := srcY + srcHeight - 1; + + { off the left edge? } + if destX < ClipRegionLeft then begin + { completely off the left edge? } + if (destX + srcWidth - 1) < ClipRegionLeft then + exit; + + offset := srcX - destX; + destX := ClipRegionLeft; + inc(srcX, offset); + dec(srcWidth, offset); + end; + + { off the right edge? } + if destX > (ClipRegionWidth - srcWidth) then begin + { completely off the right edge? } + if destX > ClipRegionRight then + exit; + + offset := destX + srcWidth - ClipRegionWidth; + dec(srcWidth, offset); + end; + + { off the top edge? } + if destY < ClipRegionTop then begin + { completely off the top edge? } + if (destY + srcHeight - 1) < ClipRegionTop then + exit; + + offset := srcY - destY; + destY := ClipRegionTop; + inc(srcY, offset); + dec(srcHeight, offset); + end; + + { off the bottom edge? } + if destY > (ClipRegionHeight - srcHeight) then begin + { completely off the bottom edge? } + if destY > ClipRegionBottom then + exit; + + offset := destY + srcHeight - ClipRegionHeight; + dec(srcHeight, offset); + end; + + ClipBlitToClipRegion := true; +end; + +end. diff --git a/GDLIB/GDEVENTS.PAS b/GDLIB/GDEVENTS.PAS new file mode 100644 index 0000000..a21c4da --- /dev/null +++ b/GDLIB/GDEVENTS.PAS @@ -0,0 +1,229 @@ +{ GDlib Input device events + Gered King, 2018 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDEvents; + +interface + +uses GDKeybrd, GDMouse; + +const + EVENT_TYPE_KEYBOARD = 1; + EVENT_TYPE_MOUSE_MOTION = 2; + EVENT_TYPE_MOUSE_BUTTON = 3; + EVENT_ACTION_PRESSED = 1; + EVENT_ACTION_RELEASED = 2; + EVENT_ACTION_HELD = 3; + +type + EventType = byte; + EventAction = byte; + + InputEvent = record + case Event: EventType of + EVENT_TYPE_KEYBOARD: ( + KB_Key : Key; + KB_Action : EventAction; + KB_Modifier : word; + ); + EVENT_TYPE_MOUSE_MOTION: ( + MM_X : integer; + MM_Y : integer; + MM_DeltaX : integer; + MM_DeltaY : integer; + MM_Buttons : MouseButton; + ); + EVENT_TYPE_MOUSE_BUTTON: ( + MB_X : integer; + MB_Y : integer; + MB_Button : MouseButton; + MB_Action : EventAction; + ); + end; + + PInputEvent = ^InputEvent; + +function InitEvents : boolean; +function CloseEvents : boolean; +function IsEventsInitialized : boolean; +function IsEventsEmpty : boolean; +function PollEvents : PInputEvent; +function PeekEvents : PInputEvent; +procedure ClearEvents; + +function PushEvent : PInputEvent; + +function IsKeyPressedEvent(event : PInputEvent; k : Key) : boolean; +function IsKeyReleasedEvent(event : PInputEvent; k : Key) : boolean; +function IsKeyHeldEvent(event : PInputEvent; k : Key) : boolean; + +implementation + +uses Toolbox; + +const + EVENT_BUFFER_SIZE = 16; + + _eventsInitialized : boolean = false; + _bufferStart : integer = 0; + _bufferEnd : integer = 0; + +var + _buffer : array[0..(EVENT_BUFFER_SIZE-1)] of InputEvent; + +function InitEvents : boolean; +{ initializes the events system, returning true if successful } +begin + if IsEventsInitialized then begin + InitEvents := false; + exit; + end; + + ClearEvents; + _eventsInitialized := true; + InitEvents := true; +end; + +function CloseEvents : boolean; +{ closes the events system, returning true if successful. } +begin + if not IsEventsInitialized then begin + CloseEvents := true; + exit; + end; + + _eventsInitialized := false; + ClearEvents; + CloseEvents := true; +end; + +function IsEventsInitialized : boolean; +{ returns true if the events system has been initialized } +begin + IsEventsInitialized := _eventsInitialized; +end; + +function IsEventsEmpty : boolean; +{ returns true if there are no events to be processed currently } +begin + IsEventsEmpty := (_bufferStart = _bufferEnd); +end; + +function PollEvents : PInputEvent; +{ returns the next input event in the buffer, or nil if there was none. + calling this function moves the input event buffer head to the next event } +begin + if IsEventsEmpty then begin + PollEvents := nil; + exit; + end; + + asm cli end; + + { return a pointer to the event at the buffer queue head currently } + PollEvents := @_buffer[_bufferStart]; + + { move the buffer queue head to the following event } + inc(_bufferStart); + if _bufferStart >= EVENT_BUFFER_SIZE then + _bufferStart := 0; + + asm sti end; +end; + +function PeekEvents : PInputEvent; +{ returns the next input event in the buffer, or nil if there was none. + calling this function does not modify the input event buffer in any way + (subsequent calls will return the same event, and/or PollEvents can be + used immediately after to return the same event) } +begin + if IsEventsEmpty then begin + PeekEvents := nil; + exit; + end; + + { return a pointer to the event at the buffer queue head currently } + PeekEvents := @_buffer[_bufferStart]; +end; + +procedure ClearEvents; +{ clears the event buffer of all events } +begin + asm cli end; + + MemFill(@_buffer, 0, SizeOf(_buffer)); + _bufferStart := 0; + _bufferEnd := 0; + + asm sti end; +end; + +function PushEvent : PInputEvent; +{ returns a pointer to the last event on the buffer queue. it is up to the + caller to fill that event structure with the information about the event to + be "pushed" onto the queue. the buffer end pointer is incremented each + time this is called (so it won't return the same pointer for subsequent + calls). this function was mainly intended to be used by GDlib keyboard and + mouse handlers. } +begin + { return pointer to the last event in the buffer queue (which ensures + FIFO queue behaviour when adding new events) } + PushEvent := @_buffer[_bufferEnd]; + + { advance the end pointer } + inc(_bufferEnd); + if _bufferEnd >= EVENT_BUFFER_SIZE then + _bufferEnd := 0; + + { is the events buffer full? (if the end meets up to the start, it is) } + if _bufferEnd = _bufferStart then begin + { move the start up. this ensures the start always points to the oldest + event in the buffer } + inc(_bufferStart); + if _bufferStart >= EVENT_BUFFER_SIZE then + _bufferStart := 0; + end; +end; + +function IsKeyPressedEvent(event : PInputEvent; k : Key) : boolean; +{ returns true if this event is a 'key pressed' event for the given key } +begin + if event = nil then + IsKeyPressedEvent := false + else + with event^ do begin + IsKeyPressedEvent := (Event = EVENT_TYPE_KEYBOARD) + and (KB_Action = EVENT_ACTION_PRESSED) + and (KB_Key = k); + end; +end; + +function IsKeyReleasedEvent(event : PInputEvent; k : Key) : boolean; +{ returns true if this event is a 'key released' event for the given key } +begin + if event = nil then + IsKeyReleasedEvent := false + else + with event^ do begin + IsKeyReleasedEvent := (Event = EVENT_TYPE_KEYBOARD) + and (KB_Action = EVENT_ACTION_RELEASED) + and (KB_Key = k); + end; +end; + +function IsKeyHeldEvent(event : PInputEvent; k : Key) : boolean; +{ returns true if this event is a 'key held' event for the given key } +begin + if event = nil then + IsKeyHeldEvent := false + else + with event^ do begin + IsKeyHeldEvent := (Event = EVENT_TYPE_KEYBOARD) + and (KB_Action = EVENT_ACTION_HELD) + and (KB_Key = k); + end; +end; + +end. diff --git a/GDLIB/GDGFX.PAS b/GDLIB/GDGFX.PAS new file mode 100644 index 0000000..af576b2 --- /dev/null +++ b/GDLIB/GDGFX.PAS @@ -0,0 +1,2140 @@ +{ GDlib Core VGA mode 13h Graphics routines + Gered King, 2018-2021 } + +{ + TODO list: + - palette loading/saving to binary .pal files + - custom font support, including variable-width fonts + - allowing usage of EMS memory to have extra gfx layers located in EMS + - clip-region stack, with push/pop type api + - blit sprite routine that allows blitting all non-transparent colours + using a single specified solid colour (e.g. for sprite flashing effect) + - translucent/blending colour table mapping and drawing routines + - scaled/rotated blit routines ... ? +} + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDGfx; + +interface + +const + MAX_LAYERS = 5; + MAX_EXTRA_LAYERS = 5; + SCREEN_LAYER = 0; + + SCREEN_LEFT = 0; + SCREEN_TOP = 0; + SCREEN_RIGHT = 319; + SCREEN_BOTTOM = 199; + SCREEN_WIDTH = 320; + SCREEN_HEIGHT = 200; + + CHAR_WIDTH = 8; + CHAR_HEIGHT = 8; + + LAYERFLAG_ALIASEDMEM = $1; + + ClipRegionLeft : integer = SCREEN_LEFT; + ClipRegionTop : integer = SCREEN_TOP; + ClipRegionRight : integer = SCREEN_RIGHT; + ClipRegionBottom : integer = SCREEN_BOTTOM; + ClipRegionWidth : integer = SCREEN_WIDTH; + ClipRegionHeight : integer = SCREEN_HEIGHT; + +type + Color = byte; + PColor = ^Color; + + PalResult = (PalNotFound, PalIOError, PalBadFile, PalBadArgs, PalOk); + + Palette = array[0..255,0..2] of byte; + PaletteEntry = array[0..2] of byte; + PPalette = ^Palette; + PPaletteEntry = ^PaletteEntry; + + Pixelbuffer = array[0..63999] of Color; + PPixelbuffer = ^Pixelbuffer; + + BiosFontTable = array[0..255,0..7] of byte; + BiosFontChar = array[0..7] of byte; + BiosFontCharWidths = array[0..255] of byte; + PBiosFontChar = ^BiosFontChar; + + FontResult = (FontNotFound, FontIOError, FontBadFile, FontBadArgs, FontOk); + + Font = record + chars : BiosFontTable; + widths : BiosFontCharWidths; + height : byte; + end; + PFont = ^Font; + + Bitmap = record + Width, Height : word; + Pixels : byte; { take pointer of this to get full pixels mem } + end; + PBitmap = ^Bitmap; + +var + VgaFramebuffer : Pixelbuffer absolute $a000:$0000; + +procedure InitGraphics(layers: integer); +procedure CloseGraphics; +function IsGraphicsInitialized: boolean; +procedure UseLayer(layer: integer); +procedure Cls(color: Color); +procedure Flip(layer: integer); +procedure CopyLayer(layer: integer); +procedure WaitForVsync; +function GetBoundLayerIndex : integer; +function GetBoundLayerSegment : word; +function GetBoundLayerOffset : word; +function GetBoundLayerOffsetAt(x, y: integer) : word; +function GetBoundLayerPointerAt(x, y: integer) : pointer; +procedure SetClipRegion(x1, y1, x2, y2: integer); +procedure ResetClipRegion; +procedure Pset(x, y: integer; color: Color); +procedure Psetf(x, y: integer; color: Color); +function Pget(x, y: integer) : Color; +function Pgetf(x, y: integer) : Color; +procedure Line(x1, y1, x2, y2: integer; color: Color); +procedure Linef(x1, y1, x2, y2: integer; color: Color); +procedure HLine(x1, x2, y: integer; color: Color); +procedure HLinef(x1, x2, y: integer; color: Color); +procedure VLine(x, y1, y2: integer; color: Color); +procedure VLinef(x, y1, y2: integer; color: Color); +procedure Box(x1, y1, x2, y2: integer; color: Color); +procedure Boxf(x1, y1, x2, y2: integer; color: Color); +procedure FilledBox(x1, y1, x2, y2: integer; color: Color); +procedure FilledBoxf(x1, y1, x2, y2: integer; color: Color); +procedure UseFont(font : PFont); +procedure DrawSubString(x, y: integer; color: Color; const text: string; textStart, textEnd: integer); +procedure DrawString(x, y: integer; color: Color; const text: string); +procedure DrawStringf(x, y: integer; color: Color; const text: string); +procedure PrintAt(x, y: integer); +procedure PrintShortInt(value: shortint; color: Color); +procedure PrintInt(value: integer; color: Color); +procedure PrintLongInt(value: longint; color: Color); +procedure PrintByte(value: byte; color: Color); +procedure PrintWord(value: word; color: Color); +procedure PrintReal(value: real; color: Color); +procedure PrintRealFmt(value: real; decimals: integer; color: Color); +procedure PrintSingle(value: single; color: Color); +procedure PrintSingleFmt(value: single; decimals: integer; color: Color); +procedure PrintDouble(value: double; color: Color); +procedure PrintDoubleFmt(value: double; decimals: integer; color: Color); +procedure PrintString(const text: string; color: Color); +procedure AllocBitmap(width, height: word; var bmp: PBitmap); +procedure FreeBitmap(bmp: PBitmap); +procedure GrabBitmap(x, y: integer; width, height: word; bmp: PBitmap); +procedure BlitSubset(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; const bmp: PBitmap); +procedure BlitSubsetf(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; const bmp: PBitmap); +procedure Blit(x, y: integer; const bmp: PBitmap); +procedure Blitf(x, y: integer; const bmp: PBitmap); +procedure BlitSpriteSubset(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; const bmp: PBitmap); +procedure BlitSpriteSubsetf(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; const bmp: PBitmap); +procedure BlitSprite(x, y: integer; const bmp: PBitmap); +procedure BlitSpritef(x, y: integer; const bmp: PBitmap); +procedure SetColor(color, r, g, b: byte); +procedure GetColor(color: byte; var r, g, b: byte); +procedure SetPalette(const pal: PPalette); +procedure GetPalette(pal: PPalette); +function FadeColor(color, r, g, b: byte; step: integer) : boolean; +procedure FadeRangeToColor(colorStart, colorEnd, r, g, b: byte; step: integer); +procedure FadeRangeToPalette(colorStart, colorEnd: byte; const pal: PPalette; step: integer); +function LoadFont(const filename: string; font: PFont) : FontResult; +function LoadPalette(const filename: string; pal: PPalette) : FontResult; + +implementation + +uses GDClip, Toolbox; + +type + GraphicsLayer = record + flags : word; + pixels : PPixelbuffer; + end; + +const + _graphicsInitialized : boolean = false; + +var + _layers : array[0..(MAX_LAYERS+1)] of GraphicsLayer; + _boundLayerIndex : integer; + _boundLayerSeg : word; + _boundLayerOfs : word; + _biosFont : BiosFontTable absolute $ffa6:$000e; + _boundFont : PFont; + _valueString : string[100]; + _currentTextX : integer; + _currentTextY : integer; + _currentTextStartX : integer; + +procedure InitGraphics(layers: integer); +{ initializes vga mode 13h graphics and allocates memory for any requested + layers in addition to the vga framebuffer layer } +var + i : integer; +begin + if _graphicsInitialized then + exit; + if layers > MAX_LAYERS then + RunError(255); + + _layers[SCREEN_LAYER].flags := LAYERFLAG_ALIASEDMEM; + _layers[SCREEN_LAYER].pixels := Ptr($a000,$0); + + for i := 1 to layers do begin + _layers[i].flags := 0; + GetMem(_layers[i].pixels, SizeOf(Pixelbuffer)); + MemFill(_layers[i].pixels, 0, SizeOf(PixelBuffer)); + end; + + { zero out remaining layer info (if there is any leftovers) } + if layers < MAX_LAYERS then begin + for i := (layers+1) to MAX_LAYERS do begin + _layers[i].flags := 0; + _layers[i].pixels := nil; + end; + end; + + ResetClipRegion; + UseLayer(SCREEN_LAYER); + Cls(0); + + asm + mov ax, 13h + int 10h + end; + + _currentTextX := 0; + _currentTextY := 0; + _currentTextStartX := 0; + _boundFont := nil; + _graphicsInitialized := true; +end; + +procedure CloseGraphics; +{ resets the screen mode back to text mode, and frees memory allocated for + any allocated layers } +var + i : integer; +begin + if (not _graphicsInitialized) then + exit; + + UseLayer(0); + + for i := 0 to MAX_LAYERS do begin + if (_layers[i].flags and LAYERFLAG_ALIASEDMEM) = 0 then begin + if _layers[i].pixels <> nil then + FreeMem(_layers[i].pixels, SizeOf(Pixelbuffer)); + end; + _layers[i].flags := 0; + _layers[i].pixels := nil; + end; + + asm + mov ax, 03h + int 10h + end; + + _graphicsInitialized := false; +end; + +function IsGraphicsInitialized: boolean; +begin + IsGraphicsInitialized := _graphicsInitialized; +end; + +procedure UseLayer(layer: integer); +{ switches the active graphics layer } +var + pixelsPtr : pointer; +begin + pixelsPtr := _layers[layer].pixels; + if pixelsPtr = nil then + RunError(255); + + _boundLayerIndex := layer; + _boundLayerSeg := PtrSeg(pixelsPtr); + _boundLayerOfs := PtrOfs(pixelsPtr); +end; + +procedure Cls(color: Color); +{ clears the current bound layer with the specified color } +begin + MemFill(Ptr(_boundLayerSeg, _boundLayerOfs), color, 64000); +end; + +procedure Flip(layer: integer); +{ 'flips' the specified layer onto the vga framebuffer } +var + layerPixelsPtr : pointer; +begin + if layer = SCREEN_LAYER then + exit; + + layerPixelsPtr := _layers[layer].pixels; + if layerPixelsPtr = nil then + RunError(255); + + MemCopy(Ptr($a000, 0), layerPixelsPtr, 64000); +end; + +procedure CopyLayer(layer: integer); +{ copies the entire contents of the specified layer onto the currently + bound layer } +var + layerPixelsPtr : pointer; +begin + if layer = _boundLayerIndex then + exit; + + layerPixelsPtr := _layers[layer].pixels; + if layerPixelsPtr = nil then + RunError(255); + + MemCopy(Ptr(_boundLayerSeg, _boundLayerOfs), layerPixelsPtr, 64000); +end; + +procedure WaitForVsync; +{ blocks until the next v-sync occurs } +assembler; +asm + mov dx, 3dah +@first: + in al, dx + and al, 8 + jnz @first +@second: + in al, dx + and al, 8 + jz @second +end; + +function GetBoundLayerIndex : integer; +{ returns the number/index of the currently bound layer } +begin + GetBoundLayerIndex := _boundLayerIndex; +end; + +function GetBoundLayerSegment : word; +{ returns the address segment of the currently bound layer } +begin + GetBoundLayerSegment := _boundLayerSeg; +end; + +function GetBoundLayerOffset : word; +{ returns the offset of the currently bound layer (this will be the offset + that corresponds with X=0,Y=0 on the layer). } +begin + GetBoundLayerOffset := _boundLayerOfs; +end; + +function GetBoundLayerOffsetAt(x, y: integer) : word; +{ returns the memory offset that the pixel at position x,y is located at + within any of the screen layers } +assembler; +asm + mov ax, y { ax = y * 320 } + mov bx, ax + shl ax, 6 + shl bx, 8 + add ax, bx + + add ax, x { ax = ax + x } + add ax, _boundLayerOfs +end; + +function GetBoundLayerPointerAt(x, y: integer) : pointer; +{ returns a pointer to the pixel at position x,y on the currently bound + layer } +assembler; +asm + mov ax, y { ax = y * 320 } + mov bx, ax + shl ax, 6 + shl bx, 8 + add ax, bx + + add ax, x { ax = ax + x } + + { return pointer in dx:ax (segment:offset) } + add ax, _boundLayerOfs + mov dx, _boundLayerSeg +end; + +function GetBitmapOffsetAt(x, y: integer; const bmp: PBitmap) : word; +{ returns the memory offset that the pixel at position x,y is located at + within the given bitmap } +begin + GetBitmapOffsetAt := (y * bmp^.Width) + x + Ofs(bmp^.Pixels); +end; + +procedure SetClipRegion(x1, y1, x2, y2: integer); +{ changes the current boundaries for all clipped drawing operations. + affects all layers. } +begin + if x1 < SCREEN_LEFT then + ClipRegionLeft := SCREEN_LEFT + else + ClipRegionLeft := x1; + + if y1 < SCREEN_TOP then + ClipRegionTop := SCREEN_TOP + else + ClipRegionTop := y1; + + if x2 > SCREEN_RIGHT then + ClipRegionRight := SCREEN_RIGHT + else + ClipRegionRight := x2; + + if y2 > SCREEN_BOTTOM then + ClipRegionBottom := SCREEN_BOTTOM + else + ClipRegionBottom := y2; + + ClipRegionWidth := ClipRegionRight - ClipRegionLeft + 1; + ClipRegionHeight := ClipRegionBottom - ClipRegionTop + 1; +end; + +procedure ResetClipRegion; +{ resets the current boundaries for all clipped drawing operations to + match the full screen boundaries } +begin + ClipRegionLeft := SCREEN_LEFT; + ClipRegionTop := SCREEN_TOP; + ClipRegionRight := SCREEN_RIGHT; + ClipRegionBottom := SCREEN_BOTTOM; + ClipRegionWidth := SCREEN_WIDTH; + ClipRegionHeight := SCREEN_HEIGHT; +end; + +procedure Pset(x, y: integer; color: Color); +{ draws a pixel on the current layer at x,y using the given color. + nothing is drawn if x,y are out of bounds of the current clipping region } +assembler; +asm + mov ax, x + cmp ax, ClipRegionLeft { off the left edge? } + jl @done + cmp ax, ClipRegionRight { off the right edge? } + jg @done + + mov di, y + cmp di, ClipRegionTop { off the top edge? } + jl @done + cmp di, ClipRegionBottom { off the bottom edge? } + jg @done + + mov bx, di { di = y * 320 + x } + shl di, 6 + shl bx, 8 + add di, bx + add di, ax + add di, _boundLayerOfs + + mov al, color + + mov es, _boundLayerSeg { write pixel to current layer } + mov es:[di], al + +@done: +end; + +procedure Psetf(x, y: integer; color: Color); +{ draws a pixel on the current layer at x,y using the given color. + does not perform any bounds checking. } +assembler; +asm + mov ax, x + mov di, y + + mov bx, di { di = y * 320 + x } + shl di, 6 + shl bx, 8 + add di, bx + add di, ax + add di, _boundLayerOfs + + mov al, color + + mov es, _boundLayerSeg { write pixel to current layer } + mov es:[di], al +end; + +function Pget(x, y: integer) : Color; +{ gets a pixel from the current layer at x,y, returning the color. + returns zero if x,y are out of bounds of the current clipping region } +assembler; +asm + xor ax, ax + + mov cx, x + cmp cx, ClipRegionLeft { off the left edge? } + jl @done + cmp cx, ClipRegionRight { off the right edge? } + jg @done + + mov si, y + cmp si, ClipRegionTop { off the top edge? } + jl @done + cmp si, ClipRegionBottom { off the bottom edge? } + jg @done + + mov bx, si { si = y * 320 + x } + shl si, 6 + shl bx, 8 + add si, bx + add si, cx + add si, _boundLayerOfs + + push ds + + mov ds, _boundLayerSeg { read pixel from current layer } + mov al, ds:[si] + + pop ds + +@done: +end; + +function Pgetf(x, y: integer) : Color; +{ gets a pixel from the current layer at x,y, returning the color. + does not perform any bounds checking. } +assembler; +asm + xor ax, ax + + mov cx, x + mov si, y + + mov bx, si { si = y * 320 + x } + shl si, 6 + shl bx, 8 + add si, bx + add si, cx + add si, _boundLayerOfs + + push ds + + mov ds, _boundLayerSeg { read pixel from current layer } + mov al, ds:[si] + + pop ds +end; + +procedure Line(x1, y1, x2, y2: integer; color: Color); +{ draws a line from x1,y1 to x2,y2. the line is clipped at the edges of the + current clipping region if necessary. } +var + deltaX, deltaY : integer; + deltaXabs, deltaYabs : integer; + deltaXsign, deltaYsign : integer; + x, y, i, dx, dy, loops : integer; + offset : integer; + offsetXinc, offsetYinc : integer; + dest : PColor; +begin + dx := x1; + dy := y1; + deltaX := x2 - x1; + deltaY := y2 - y1; + deltaXabs := Abs(deltaX); + deltaYabs := Abs(deltaY); + deltaXsign := SignInt(deltaX); + deltaYsign := SignInt(deltaY); + x := deltaYabs div 2; + y := deltaYabs div 2; + offsetXinc := deltaXsign; + offsetYinc := deltaYsign * SCREEN_WIDTH; + dest := GetBoundLayerPointerAt(x1, y1); + + if ((dx >= ClipRegionLeft) + and (dy >= ClipRegionTop) + and (dx <= ClipRegionRight) + and (dy <= ClipRegionBottom)) then + dest^ := color; + + if deltaXabs >= deltaYabs then begin + loops := deltaXabs - 1; + for i := 0 to loops do begin + inc(y, deltaYabs); + + if y >= deltaXabs then begin + dec(y, deltaXabs); + inc(dy, deltaYsign); + inc(dest, offsetYinc); + end; + + inc(dx, deltaXsign); + inc(dest, offsetXinc); + + if ((dx >= ClipRegionLeft) + and (dy >= ClipRegionTop) + and (dx <= ClipRegionRight) + and (dy <= ClipRegionBottom)) then + dest^ := color; + end; + + end else begin + loops := deltaYabs - 1; + for i := 0 to loops do begin + inc(x, deltaXabs); + + if x >= deltaYabs then begin + dec(x, deltaYabs); + inc(dx, deltaXsign); + inc(dest, offsetXinc); + end; + + inc(dy, deltaYsign); + inc(dest, offsetYinc); + + if ((dx >= ClipRegionLeft) + and (dy >= ClipRegionTop) + and (dx <= ClipRegionRight) + and (dy <= ClipRegionBottom)) then + dest^ := color; + end; + end; +end; + +procedure Linef(x1, y1, x2, y2: integer; color: Color); +{ draws a line from x1,y1 to x2,y2. no clipping is performed. } +var + deltaX, deltaY : integer; + deltaXabs, deltaYabs : integer; + deltaXsign, deltaYsign : integer; + x, y, i, loops : integer; + offsetXinc, offsetYinc : integer; + dest : PColor; +begin + deltaX := x2 - x1; + deltaY := y2 - y1; + deltaXabs := Abs(deltaX); + deltaYabs := Abs(deltaY); + deltaXsign := SignInt(deltaX); + deltaYsign := SignInt(deltaY); + x := deltaYabs div 2; + y := deltaYabs div 2; + offsetXinc := deltaXsign; + offsetYinc := deltaYsign * SCREEN_WIDTH; + dest := GetBoundLayerPointerAt(x1, y1); + + dest^ := color; + + if deltaXabs >= deltaYabs then begin + loops := deltaXabs - 1; + for i := 0 to loops do begin + inc(y, deltaYabs); + + if y >= deltaXabs then begin + dec(y, deltaXabs); + inc(dest, offsetYinc); + end; + + inc(dest, offsetXinc); + + dest^ := color; + end; + + end else begin + loops := deltaYabs - 1; + for i := 0 to loops do begin + inc(x, deltaXabs); + + if x >= deltaYabs then begin + dec(x, deltaYabs); + inc(dest, offsetXinc); + end; + + inc(dest, offsetYinc); + + dest^ := color; + end; + end; +end; + +procedure HLine(x1, x2, y: integer; color: Color); +{ draws a horizontal line. automatically compensates for incorrect ordering + of the x coordinates and also clips the line to the current clipping + region. } +begin + if x2 < x1 then + SwapInts(x1, x2); + if not ClampToClipRegion(x1, y, x2, y) then + exit; + + HLinef(x1, x2, y, color); +end; + +procedure HLinef(x1, x2, y: integer; color: Color); +{ draws a horizontal line. x1 must be less than x2. no clipping is + performed. } +var + dest : pointer; + length : integer; +begin + dest := GetBoundLayerPointerAt(x1, y); + length := x2 - x1 + 1; + MemFill(dest, color, length); +end; + +procedure VLine(x, y1, y2: integer; color: Color); +{ draws a vertical line. automatically compensates for incorrect ordering + of the y coordinates and also clips the line to the current clipping + region. } +begin + if y2 < y1 then + SwapInts(y1, y2); + if not ClampToClipRegion(x, y1, x, y2) then + exit; + + VLinef(x, y1, y2, color); +end; + +procedure VLinef(x, y1, y2: integer; color: Color); +{ draws a vertical line. y1 must be less than y2. no clipping is + performed. } +var + offs : word; + linesLeft : integer; +begin + offs := GetBoundLayerOffsetAt(x, y1); + linesLeft := y2 - y1 + 1; + + asm + mov cx, linesLeft + test cx, cx { make sure there are > 0 lines to draw } + jz @done + + mov al, color + mov es, _boundLayerSeg + mov di, offs + +@draw: + mov es:[di], al + add di, SCREEN_WIDTH + dec cx + jnz @draw + +@done: + end; +end; + +procedure DrawTwoVerticalLines(leftOffs, rightOffs: word; + color: Color; + height: integer); +assembler; +asm + mov es, _boundLayerSeg + mov si, leftOffs + mov di, rightOffs + mov al, color + mov cx, height + +@draw: + mov es:[si], al + mov es:[di], al + add si, SCREEN_WIDTH + add di, SCREEN_WIDTH + dec cx + jnz @draw + +@done: +end; + +procedure DrawVerticalLine(offs: word; + color: Color; + height: integer); +assembler; +asm + mov es, _boundLayerSeg + mov di, offs + mov al, color + mov cx, height + +@draw: + mov es:[di], al + add di, SCREEN_WIDTH + dec cx + jnz @draw + +@done: +end; + +procedure Box(x1, y1, x2, y2: integer; color: Color); +{ draws an empty box. automatically compensates if coordinate pairs are + swapped so that x1 < x2 and y1 < y2. clips the box to the current clipping + region boundaries. } +var + clippedX1, clippedY1, clippedX2, clippedY2 : integer; + clippedWidth, clippedHeight : integer; + offs, offs1, offs2 : word; +begin + if x2 < x1 then + SwapInts(x1, x2); + if y2 < y1 then + SwapInts(y1, y2); + + clippedX1 := x1; + clippedY1 := y1; + clippedWidth := x2 - x1 + 1; + clippedHeight := y2 - y1 + 1; + + if not ClipToClipRegion(clippedX1, clippedY1, + clippedWidth, clippedHeight) then + exit; + + clippedX2 := clippedX1 + clippedWidth - 1; + clippedY2 := clippedY1 + clippedHeight - 1; + + { top line, only if y1 was within bounds } + if y1 = clippedY1 then begin + offs := GetBoundLayerOffsetAt(clippedX1, clippedY1); + MemFill(Ptr(_boundLayerSeg, offs), color, clippedWidth); + end; + + { bottom line, only if y2 was within bounds } + if y2 = clippedY2 then begin + offs := GetBoundLayerOffsetAt(clippedX1, clippedY2); + MemFill(Ptr(_boundLayerSeg, offs), color, clippedWidth); + end; + + { draw both left and right lines if neither x1 nor x2 were clipped } + if (x1 = clippedX1) and (x2 = clippedX2) then begin + offs1 := GetBoundLayerOffsetAt(clippedX1, clippedY1); + offs2 := GetBoundLayerOffsetAt(clippedX2, clippedY1); + DrawTwoVerticalLines(offs1, offs2, color, clippedHeight); + + { draw left line if x1 was not clipped } + end else if x1 = clippedX1 then begin + offs := GetBoundLayerOffsetAt(clippedX1, clippedY1); + DrawVerticalLine(offs, color, clippedHeight); + + { draw right line if x2 was not clipped } + end else if x2 = clippedX2 then begin + offs := GetBoundLayerOffsetAt(clippedX2, clippedY1); + DrawVerticalLine(offs, color, clippedHeight); + + end; +end; + +procedure Boxf(x1, y1, x2, y2: integer; color: Color); +{ draws an empty box. x1 must be less than x2, and y1 must be less than y2. + no clipping is performed. } +var + offs, offsLeft, offsRight : word; + width, linesLeft : integer; +begin + width := x2 - x1 + 1; + linesLeft := y2 - y1; + offs := GetBoundLayerOffsetAt(x1, y1); + offsLeft := offs; + offsRight := offs + width - 1; + + asm + mov al, color { spread color byte over all of EAX so we can } + mov ah, al { draw 4 pixels at once horizontally. } + db $66; shl ax, 8 { shl eax, 8 } + mov al, ah + db $66; shl ax, 8 { shl eax, 8 } + mov al, ah + + db $66; xor cx, cx { xor ecx, ecx } + mov es, _boundLayerSeg + mov dx, width + mov cx, linesLeft + mov di, offsLeft + mov si, offsRight + + test cx, cx { do we have any vertical height to draw? } + jz @draw_horiz1 { if not, skip to horizontal drawing ... } + +@draw_vert: + { draw both vertical lines } + mov es:[di], al + mov es:[si], al + add di, SCREEN_WIDTH + add si, SCREEN_WIDTH + dec cx + jnz @draw_vert + +@draw_horiz1: + { di will be at (x1,y2) currently. this is the correct location to draw + the bottom horizontal line } + mov cx, dx { cx = number of dwords to draw } + mov bx, cx { bx = remaining number of pixels to draw } + shr cx, 2 + and bx, 3 + + db $f3,$66,$ab { rep stosd - draw dwords } + mov cx, bx + rep stosb { draw remaining pixels } + +@draw_horiz2: + { now draw the top line. reposition to (x1,y1) } + mov di, offsLeft + mov cx, dx { cx = number of dwords to draw } + mov bx, cx { bx = remaining number of pixels to draw } + shr cx, 2 + and bx, 3 + + db $f3,$66,$ab { rep stosd - draw dwords } + mov cx, bx + rep stosb { draw remaining pixels } + +@done: + end; +end; + +procedure FilledBox(x1, y1, x2, y2: integer; color: Color); +{ draws a filled box. automatically compensates if coordinate pairs are + swapped so that x1 < x2 and y1 < y2. clips the box to the current clipping + region boundaries. } +begin + if x2 < x1 then + SwapInts(x1, x2); + if y2 < y1 then + SwapInts(y1, y2); + + if not ClampToClipRegion(x1, y1, x2, y2) then + exit; + + FilledBoxf(x1, y1, x2, y2, color); +end; + +procedure FilledBoxf(x1, y1, x2, y2: integer; color: Color); +{ draws a filled box. x1 must be less than x2, and y1 must be less than y2. + no clipping is performed. } +var + offs : word; + width, linesLeft, remainder : integer; +begin + width := x2 - x1 + 1; + linesLeft := y2 - y1 + 1; + offs := GetBoundLayerOffsetAt(x1, y1); + + asm + mov si, linesLeft + test si, si { stop if there are 0 lines to draw } + jz @nothing_to_draw + + mov al, color { spread color byte over all of EAX so we can } + mov ah, al { draw 4 pixels at once horizontally. } + db $66; shl ax, 8 { shl eax, 8 } + mov al, ah + db $66; shl ax, 8 { shl eax, 8 } + mov al, ah + + mov bx, width + mov di, offs + mov es, _boundLayerSeg + mov dx, SCREEN_WIDTH { dx = y-inc to next line after drawing horiz } + sub dx, bx + + { *** WARNING: no stack/vars access after this! *** } + push bp + mov bp, bx + and bp, 3 { bp = remaining number of pixels to draw } + shr bx, 2 { bx = number of dwords to draw } + + db $66; xor cx, cx { xor ecx, ecx } + + test bp, bp + jz @draw + +@draw_with_remainder: + mov cx, bx + db $f3,$66,$ab { rep stosd - draw dwords } + mov cx, bp + rep stosb { draw remainder pixel } + add di, dx { move to start of next line } + dec si { decrease line counter } + jnz @draw_with_remainder { keep drawing if there are more lines } + jmp @done + +@draw: + mov cx, bx + db $f3,$66,$ab { rep stosd - draw dwords } + add di, dx { move to start of next line } + dec si { decrease line counter } + jnz @draw { keep drawing if there are more lines } + jmp @done + +@done: + pop bp +@nothing_to_draw: + end; +end; + +procedure UseFont(font : PFont); +{ binds the specified font. all subsequent text/string drawing will be + done using this font until this is called again with a different font. + pass nil to revert back to using the standard VGA BIOS font. } +begin + if font = nil then + _boundFont := nil { means to use VGA BIOS font instead } + else + _boundFont := font; +end; + +{ TODO: rewrite this function. it is poopy and sad. } +procedure DrawChar(x, y, drawX, drawY, width, height: integer; + color: Color; + ch: char); +var + dest, fontSrc : word; + cx, cy : integer; + offsetX, offsetY : integer; + destWidth, destHeight : integer; + fontCharMap : PBiosFontChar; + fontCharLine : byte; + pixel : byte; +begin + dest := GetBoundLayerOffsetAt(drawX, drawY); + + if _boundFont <> nil then + fontCharMap := @_boundFont^.chars[Ord(ch), 0] + else + fontCharMap := @_biosFont[Ord(ch), 0]; + + { get offset x,y to start drawing char from (will be in range 0-7) } + offsetX := drawX - x; + offsetY := drawY - y; + destWidth := width + offsetX - 1; + destHeight := height + offsetY - 1; + + { cx,cy are always in "char coordinate space" (that is, 0-7) } + for cy := offsetY to destHeight do begin + fontCharLine := fontCharMap^[cy]; + + for cx := offsetX to destWidth do begin + pixel := ((fontCharLine) and (1 shl ((CHAR_WIDTH - 1) - cx))); + if pixel > 0 then + mem[_boundLayerSeg:(dest + (cx - offsetX))] := color; + end; + + inc(dest, SCREEN_WIDTH); + end; +end; + +procedure DrawSubString(x, y: integer; + color: Color; + const text: string; + textStart, textEnd: integer); +{ draws a sub-string starting from the top-left coordinate (x,y). handles + multi-line strings automatically. the text is clipped to the current + clipping region boundaries as needed. only part of the string is drawn, + as specified by textStart and textEnd (non-inclusive end) } +var + ch : char; + i, currentX, currentY : integer; + width, height, length : integer; + spaceWidth : integer; + clippedX, clippedY : integer; + clippedWidth, clippedHeight : integer; +begin + currentX := x; + currentY := y; + width := CHAR_WIDTH; + + if _boundFont <> nil then begin + height := _boundFont^.height; + spaceWidth := _boundFont^.widths[Ord(' ')]; + end else begin + height := CHAR_HEIGHT; + spaceWidth := CHAR_WIDTH; + end; + + for i := textStart to textEnd do begin + ch := text[i]; + case ch of + { move to next line } + #10: begin + currentX := x; + inc(currentY, height); + end; + #13: begin; + end; + { skip a character ahead, no need to "draw" a space char (empty) } + ' ': inc(currentX, spaceWidth); + else begin + if _boundFont <> nil then + width := _boundFont^.widths[Ord(ch)]; + + clippedX := currentX; + clippedY := currentY; + clippedWidth := width; + clippedHeight := height; + if ClipToClipRegion(clippedX, clippedY, clippedWidth, clippedHeight) then + DrawChar(currentX, currentY, clippedX, clippedY, clippedWidth, clippedHeight, color, ch); + + inc(currentX, width); + end; + end; + end; +end; + +procedure DrawString(x, y: integer; color: Color; const text: string); +{ draws a string starting from the top-left coordinate (x,y). handles + multi-line strings automatically. the text is clipped to the current + clipping region boundaries as needed. } +begin + DrawSubString(x, y, color, text, 1, length(text)); +end; + +procedure DrawStringf(x, y: integer; color: Color; const text: string); +{ draws a string starting from the top-left coordinate (x,y). handles + multi-line strings automatically. no clipping is performed. } +var + ch : char; + i, currentX, currentY : integer; + width, height, len : integer; + spaceWidth : integer; +begin + currentX := x; + currentY := y; + width := CHAR_WIDTH; + len := length(text); + + if _boundFont <> nil then begin + height := _boundFont^.height; + spaceWidth := _boundFont^.widths[Ord(' ')]; + end else begin + height := CHAR_HEIGHT; + spaceWidth := CHAR_WIDTH; + end; + + for i := 1 to len do begin + ch := text[i]; + case ch of + { move to next line } + #10: begin + currentX := x; + inc(currentY, height); + end; + #13: begin; + end; + { skip a character ahead, no need to "draw" a space char (empty) } + ' ': inc(currentX, spaceWidth); + else begin + if _boundFont <> nil then + width := _boundFont^.widths[Ord(ch)]; + + DrawChar(currentX, currentY, currentX, currentY, width, height, color, ch); + inc(currentX, width); + end; + end; + end; +end; + +procedure PrintAt(x, y: integer); +{ sets the text position for subsequent calls to any of the PrintXxx + functions. } +begin + if x > SCREEN_RIGHT then + exit; + if y > SCREEN_BOTTOM then + exit; + + _currentTextX := x; + _currentTextY := y; + _currentTextStartX := x; +end; + +procedure PrintShortInt(value: shortint; color: Color); +{ displays a short-integer value at the current text position. clipping is + performed as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintInt(value: integer; color: Color); +{ displays an integer value at the current text position. clipping is + performed as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintLongInt(value: longint; color: Color); +{ displays a long-integer value at the current text position. clipping is + performed as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintByte(value: byte; color: Color); +{ displays a byte value at the current text position. clipping is performed + as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintWord(value: word; color: Color); +{ displays a word value at the current text position. clipping is performed + as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintReal(value: real; color: Color); +{ displays a real value at the current text position. clipping is performed + as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintRealFmt(value: real; decimals: integer; color: Color); +{ displays a real value using a specific number of decimal points at the + current text position. clipping is performed as necessary. } +begin + Str(value:0:decimals, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintSingle(value: single; color: Color); +{ displays a single-precision value at the current text position. clipping + is performed as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintSingleFmt(value: single; decimals: integer; color: Color); +{ displays a single-precision value using a specific number of decimal points + at the current text position. clipping is performed as necessary. } +begin + Str(value:0:decimals, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintDouble(value: double; color: Color); +{ displays a double-precision value at the current text position. clipping + is performed as necessary. } +begin + Str(value, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintDoubleFmt(value: double; decimals: integer; color: Color); +{ displays a double-precision value using a specific number of decimal points + at the current text position. clipping is performed as necessary. } +begin + Str(value:0:decimals, _valueString); + DrawString(_currentTextX, _currentTextY, color, _valueString); + inc(_currentTextX, length(_valueString) * CHAR_WIDTH); +end; + +procedure PrintString(const text: string; color: Color); +{ displays a string at the current text position. handles multi-line strings + automatically. clipping is performed as necessary. } +var + ch : char; + i, width, height, len : integer; + spaceWidth : integer; + clippedX, clippedY : integer; + clippedWidth, clippedHeight : integer; +begin + width := CHAR_WIDTH; + len := length(text); + + if _boundFont <> nil then begin + height := _boundFont^.height; + spaceWidth := _boundFont^.widths[Ord(' ')]; + end else begin + height := CHAR_HEIGHT; + spaceWidth := CHAR_WIDTH; + end; + + for i := 1 to len do begin + ch := text[i]; + case ch of + { move to next line } + #10: begin + _currentTextX := _currentTextStartX; + inc(_currentTextY, height); + end; + #13: begin; + end; + { skip a character ahead, no need to "draw" a space char (empty) } + ' ': inc(_currentTextX, spaceWidth); + else begin + if _boundFont <> nil then + width := _boundFont^.widths[Ord(ch)]; + + clippedX := _currentTextX; + clippedY := _currentTextY; + clippedWidth := width; + clippedHeight := height; + if ClipToClipRegion(clippedX, clippedY, clippedWidth, clippedHeight) then + DrawChar(_currentTextX, _currentTextY, clippedX, clippedY, clippedWidth, clippedHeight, color, ch); + + inc(_currentTextX, width); + end; + end; + end; +end; + +procedure AllocBitmap(width, height: word; var bmp: PBitmap); +{ allocates the memory necessary for a bitmap of the specified size } +begin + GetMem(bmp, SizeOf(Bitmap) + (width * height) - 1); + + bmp^.Width := width; + bmp^.Height := height; +end; + +procedure FreeBitmap(bmp: PBitmap); +{ frees previously allocated memory for the given bitmap. the bitmap should + not be used again after this unless re-allocated via AllocBitmap } +begin + if bmp = nil then exit; + FreeMem(bmp, SizeOf(Bitmap) + (bmp^.width * bmp^.height) - 1); +end; + +procedure GrabBitmap(x, y: integer; width, height: word; bmp: PBitmap); +{ copies a region of pixels from the current layer onto the specified bitmap. + the bitmap must have already been allocated, and be large enough to hold + pixel data of the provided dimensions. } +var + line : word; + src, dest : ^byte; +begin + src := GetBoundLayerPointerAt(x, y); + dest := @bmp^.Pixels; + + { TODO: re-write this in inline-assembly } + for line := 0 to (height - 1) do begin + MemCopy(dest, src, width); + inc(src, SCREEN_WIDTH); + inc(dest, width); + end; +end; + + + +{ "Low-Level" Solid Blit routines. These are only really intended to be + called by the main "BlitXXX" functions, but possibly could be used directly + by applications when the utmost speed is required ... + These functions DO NOT perform any argument validation or clipping, etc! } + +procedure LLBlit4(width, height, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination. assumes the source + pixels have an exact dword-sized width. } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + db $66; xor cx, cx { xor ecx, ecx } + mov ax, width + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + + shr ax, 2 { ax = number of dwords to draw per line } + +@draw_line: + mov cx, ax + db $f3,$66,$a5 { rep movsd - draw dwords } + + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +procedure LLBlit4r(width, height, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination. assumes the source + pixels have a width composed of some dword-sized portion PLUS a remainder + of 1-3 pixels at the end. } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + db $66; xor cx, cx { xor ecx, ecx } + mov ax, width + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + + mov bx, ax + shr ax, 2 { ax = number of dwords to draw per line } + and bx, 3 { bx = remaining number of pixels } + +@draw_line: + mov cx, ax + db $f3,$66,$a5 { rep movsd - draw dwords } + mov cx, bx + rep movsb { draw remainder pixels } + + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +procedure LLBlitRemainder(width, height, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination. will just use a simple + rep movsb for each line. intended only for blits whose width is <= 3. } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + mov ax, width + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + +@draw_line: + mov cx, ax + rep movsb { draw pixels } + + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +{ End of Low-Level Solid Blit functions ^^^ } + + + +procedure BlitSubset(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; + const bmp: PBitmap); +{ draws the specified subset/region of the bitmap onto the current layer. the + bitmap is clipped to the current clipping region boundaries. } +begin + if not ClipBlitToClipRegion(srcX, srcY, srcWidth, srcHeight, destX, destY) then + exit; + + BlitSubsetf(srcX, srcY, srcWidth, srcHeight, destX, destY, bmp); +end; + +procedure BlitSubsetf(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; + const bmp: PBitmap); +{ draws the specified subset/region of the bitmap onto the current layer. no + clipping is performed. } +var + srcSeg, srcOffs, destOffs : word; + srcYinc, destYinc : integer; + width4, widthRemainder : integer; +begin + srcSeg := Seg(bmp^.Pixels); + srcOffs := GetBitmapOffsetAt(srcX, srcY, bmp); + destOffs := GetBoundLayerOffsetAt(destX, destY); + + srcYinc := bmp^.Width - srcWidth; + destYinc := SCREEN_WIDTH - srcWidth; + + width4 := srcWidth div 4; + widthRemainder := srcWidth and 3; + + if ((width4 > 0) and (widthRemainder = 0)) then begin + LLBlit4(srcWidth, srcHeight, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end else if ((width4 > 0) and (widthRemainder > 0)) then begin + LLBlit4r(srcWidth, srcHeight, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end else begin + LLBlitRemainder(srcWidth, srcHeight, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end +end; + +procedure Blit(x, y: integer; const bmp: PBitmap); +{ draws the given bitmap onto the current layer. the bitmap is clipped to + the current clipping region boundaries. } +var + srcX, srcY : integer; + srcWidth, srcHeight : integer; +begin + srcX := 0; + srcY := 0; + srcWidth := bmp^.Width; + srcHeight := bmp^.Height; + + if not ClipBlitToClipRegion(srcX, srcY, srcWidth, srcHeight, x, y) then + exit; + + BlitSubsetf(srcX, srcY, srcWidth, srcHeight, x, y, bmp); +end; + +procedure Blitf(x, y: integer; const bmp: PBitmap); +{ draws the given bitmap onto the current layer. no clipping is performed. } +begin + BlitSubsetf(0, 0, bmp^.Width, bmp^.Height, x, y, bmp); +end; + + + +{ "Low-Level" Transparent Blit routines. These are only really intended to be + called by the main "BlitXXX" functions, but possibly could be used directly + by applications when the utmost speed is required ... + These functions DO NOT perform any argument validation or clipping, etc! } + +procedure LLBlitSprite8(width8, height, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination, treating colour 0 as the + transparent pixel which will be skipped over. assumes the source pixels + have an exact double-dword-sized width (that is, an exact multiple of 8). } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + mov ax, width8 + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + +@draw_line: + mov cx, ax { cx = number of 8-pixel runs left to draw } + +@draw_px_0: + mov bx, ds:[si+0] { load two pixels } + test bl, bl + jz @draw_px_1 { if it is color 0, skip it } + mov es:[di+0], bl { otherwise, draw it } +@draw_px_1: + test bh, bh { bh has the second loaded pixel } + jz @draw_px_2 + mov es:[di+1], bh +@draw_px_2: + mov bx, ds:[si+2] + test bl, bl + jz @draw_px_3 + mov es:[di+2], bl +@draw_px_3: + test bh, bh + jz @draw_px_4 + mov es:[di+3], bh +@draw_px_4: + mov bx, ds:[si+4] + test bl, bl + jz @draw_px_5 + mov es:[di+4], bl +@draw_px_5: + test bh, bh + jz @draw_px_6 + mov es:[di+5], bh +@draw_px_6: + mov bx, ds:[si+6] + test bl, bl + jz @draw_px_7 + mov es:[di+6], bl +@draw_px_7: + test bh, bh + jz @end_run + mov es:[di+7], bh + +@end_run: + add si, 8 { mov src and dest up 8 pixels } + add di, 8 + dec cx { decrease 8-pixel run loop counter } + jnz @draw_px_0 { if there are still more runs, draw them } + +@end_line: + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +procedure LLBlitSprite4(width4, height, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination, treating colour 0 as the + transparent pixel which will be skipped over. assumes the source pixels + have an exact dword-sized width (that is, an exact multiple of 4). } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + mov ax, width4 + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + +@draw_line: + mov cx, ax { cx = number of 4-pixel runs left to draw } + +@draw_px_0: + mov bx, ds:[si+0] { load two pixels } + test bl, bl + jz @draw_px_1 { if it is color 0, skip it } + mov es:[di+0], bl { otherwise, draw it } +@draw_px_1: + test bh, bh { bh has the second loaded pixel } + jz @draw_px_2 + mov es:[di+1], bh +@draw_px_2: + mov bx, ds:[si+2] + test bl, bl + jz @draw_px_3 + mov es:[di+2], bl +@draw_px_3: + test bh, bh + jz @end_run + mov es:[di+3], bh + +@end_run: + add si, 4 { mov src and dest up 4 pixels } + add di, 4 + dec cx { decrease 4-pixel run loop counter } + jnz @draw_px_0 { if there are still more runs, draw them } + +@end_line: + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +procedure LLBlitSprite8r(width8, height, widthRemainder, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination, treating colour 0 as the + transparent pixel which will be skipped over. assumes the source pixels + have a width that is composed of a double-dword-sized section (that is, + some segment that is a multiple of 8) plus some remainder bit that is + <= 7 pixels long. } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + mov ax, width8 + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + +@draw_line: + mov cx, ax { cx = number of 8-pixel runs left to draw } + +@draw_px_0: + mov bx, ds:[si+0] { load two pixels } + test bl, bl + jz @draw_px_1 { if it is color 0, skip it } + mov es:[di+0], bl { otherwise, draw it } +@draw_px_1: + test bh, bh { bh has the second loaded pixel } + jz @draw_px_2 + mov es:[di+1], bh +@draw_px_2: + mov bx, ds:[si+2] + test bl, bl + jz @draw_px_3 + mov es:[di+2], bl +@draw_px_3: + test bh, bh + jz @draw_px_4 + mov es:[di+3], bh +@draw_px_4: + mov bx, ds:[si+4] + test bl, bl + jz @draw_px_5 + mov es:[di+4], bl +@draw_px_5: + test bh, bh + jz @draw_px_6 + mov es:[di+5], bh +@draw_px_6: + mov bx, ds:[si+6] + test bl, bl + jz @draw_px_7 + mov es:[di+6], bl +@draw_px_7: + test bh, bh + jz @end_run + mov es:[di+7], bh + +@end_run: + add si, 8 { mov src and dest up 8 pixels } + add di, 8 + dec cx { decrease 8-pixel run loop counter } + jnz @draw_px_0 { if there are still more runs, draw them } + +@start_remainder_run: { now draw remaining pixels ( <= 7 pixels ) } + mov cx, widthRemainder + +@draw_pixel: + mov bl, ds:[si] { load pixel } + inc si + test bl, bl { if zero, skip to next pixel } + jz @end_pixel + mov es:[di], bl { else, draw the pixel } +@end_pixel: + inc di + dec cx + jnz @draw_pixel + +@end_line: + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +procedure LLBlitSprite4r(width4, height, widthRemainder, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination, treating colour 0 as the + transparent pixel which will be skipped over. assumes the source pixels + have a width that is composed of a dword-sized section (that is, some + segment that is a multiple of 4) plus some remainder bit that is + <= 3 pixels long. } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + mov ax, width4 + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + +@draw_line: + mov cx, ax { cx = number of 4-pixel runs left to draw } + +@draw_px_0: + mov bx, ds:[si+0] { load two pixels } + test bl, bl + jz @draw_px_1 { if it is color 0, skip it } + mov es:[di+0], bl { otherwise, draw it } +@draw_px_1: + test bh, bh { bh has the second loaded pixel } + jz @draw_px_2 + mov es:[di+1], bh +@draw_px_2: + mov bx, ds:[si+2] + test bl, bl + jz @draw_px_3 + mov es:[di+2], bl +@draw_px_3: + test bh, bh + jz @end_run + mov es:[di+3], bh + +@end_run: + add si, 4 { mov src and dest up 4 pixels } + add di, 4 + dec cx { decrease 4-pixel run loop counter } + jnz @draw_px_0 { if there are still more runs, draw them } + +@start_remainder_run: { now draw remaining pixels ( <= 3 pixels ) } + mov cx, widthRemainder + +@draw_pixel: + mov bl, ds:[si] { load pixel } + inc si + test bl, bl { if zero, skip to next pixel } + jz @end_pixel + mov es:[di], bl { else, draw the pixel } +@end_pixel: + inc di + dec cx + jnz @draw_pixel + +@end_line: + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +procedure LLBlitSpriteRemainder(width, height, destYinc, srcYinc: integer; + destOffs, srcSeg, srcOffs: word); +{ blit a block of memory to the given destination, treating colour 0 as the + transparent pixel which will be skipped over. this is the slowest of the + transparent blit routines, that technically can draw at any width, but + is really intended for widths <= 7 only. } +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + mov ax, width + mov di, destOffs + mov si, srcOffs + mov es, _boundLayerSeg + mov ds, srcSeg + +@draw_line: + mov cx, ax { cx = number of pixels to draw } + +@draw_pixel: + mov bl, ds:[si] { load pixel } + inc si + test bl, bl { if zero, skip to next pixel } + jz @end_pixel + mov es:[di], bl { else, draw the pixel } +@end_pixel: + inc di + dec cx + jnz @draw_pixel { loop while there's still pixels left } + +@end_line: + add si, srcYinc { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +{ End of Low-Level Transparent Blit functions ^^^ } + + + +procedure BlitSpriteSubset(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; + const bmp: PBitmap); +{ draws the specified subset/region of the given bitmap onto the current + layer, ignoring color 0 (treated as transparent). the bitmap is clipped to + the current clipping region boundaries. } +begin + if not ClipBlitToClipRegion(srcX, srcY, srcWidth, srcHeight, destX, destY) then + exit; + + BlitSpriteSubsetf(srcX, srcY, srcWidth, srcHeight, destX, destY, bmp); +end; + +procedure BlitSpriteSubsetf(srcX, srcY, srcWidth, srcHeight, destX, destY: integer; + const bmp: PBitmap); +{ draws the specified subset/region of the given bitmap onto the current + layer, ignoring color 0 (treated as transparent). no clipping is + performed. } +var + srcSeg, srcOffs, destOffs : word; + srcYinc, destYinc : integer; + width4, widthRemainder : integer; +begin + srcSeg := Seg(bmp^.Pixels); + srcOffs := GetBitmapOffsetAt(srcX, srcY, bmp); + destOffs := GetBoundLayerOffsetAt(destX, destY); + + srcYinc := bmp^.Width - srcWidth; + destYinc := SCREEN_WIDTH - srcWidth; + + width4 := srcWidth div 4; + widthRemainder := srcWidth and 3; + + if (width4 > 0) and (widthRemainder = 0) then begin + if ((width4 and 1) = 0) then begin + { width is actually an even multiple of 8! } + LLBlitSprite8(width4 div 2, srcHeight, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end else begin + { width is a multiple of 4 (no remainder) } + LLBlitSprite4(width4, srcHeight, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end; + + end else if (width4 > 0) and (widthRemainder > 0) then begin + if ((width4 and 1) = 0) then begin + { width is mostly made up of an even multiple of 8. but there is also + a small remainder } + LLBlitSprite8r(width4 div 2, srcHeight, widthRemainder, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end else begin + { width is >= 4 with a remainder } + LLBlitSprite4r(width4, srcHeight, widthRemainder, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end; + + end else begin + { width is <= 3 } + LLBlitSpriteRemainder(widthRemainder, srcHeight, destYinc, srcYinc, destOffs, srcSeg, srcOffs); + end; +end; + +procedure BlitSprite(x, y: integer; const bmp: PBitmap); +{ draws the given bitmap onto the current layer, ignoring color 0 (treated + as transparent). the bitmap is clipped to the current clipping region + boundaries. } +var + srcX, srcY : integer; + srcWidth, srcHeight : integer; +begin + srcX := 0; + srcY := 0; + srcWidth := bmp^.Width; + srcHeight := bmp^.Height; + + if not ClipBlitToClipRegion(srcX, srcY, srcWidth, srcHeight, x, y) then + exit; + + BlitSpriteSubsetf(srcX, srcY, srcWidth, srcHeight, x, y, bmp); +end; + +procedure BlitSpritef(x, y: integer; const bmp: PBitmap); +{ draws the given bitmap onto the current layer, ignoring color 0 (treated + as transparent). no clipping is performed. } +begin + BlitSpriteSubsetf(0, 0, bmp^.Width, bmp^.Height, x, y, bmp); +end; + +procedure SetColor(color, r, g, b: byte); +{ changes the VGA color palette for the color specified } +begin + port[$3c6] := $ff; + port[$3c8] := color; + port[$3c9] := r; + port[$3c9] := g; + port[$3c9] := b; +end; + +procedure GetColor(color: byte; var r, g, b: byte); +{ reads the current VGA color palette RGB values for the color specified } +begin + port[$3c6] := $ff; + port[$3c7] := color; + r := port[$3c9]; + g := port[$3c9]; + b := port[$3c9]; +end; + +procedure SetPalette(const pal: PPalette); +{ sets the current VGA color palette to the given one } +var + i : integer; +begin + for i := 0 to 255 do begin + SetColor(i, pal^[i, 0], pal^[i, 1], pal^[i, 2]); + end; +end; + +procedure GetPalette(pal: PPalette); +{ reads the current VGA color palette, storing all RGB values in the + provided Palette structure } +var + i : integer; +begin + for i := 0 to 255 do begin + GetColor(i, pal^[i, 0], pal^[i, 1], pal^[i, 2]); + end; +end; + +function FadeColor(color, r, g, b: byte; step: integer) : boolean; +{ fades (in/out) the specified color towards the given RGB values by 'step' + amount. returns true if the color's RGB values have reached the target + RGB values, false otherwise. } +var + red, green, blue : byte; + diffR, diffG, diffB : byte; + modified : boolean; +begin + modified := false; + + GetColor(color, red, green, blue); + + if red <> r then begin + modified := true; + diffR := Abs(red - r); + if red > r then + dec(red, Min(step, diffR)) + else + inc(red, Min(step, diffR)); + end; + + if green <> g then begin + modified := true; + diffG := Abs(green - g); + if green > g then + dec(green, Min(step, diffG)) + else + inc(green, Min(step, diffG)); + end; + + if blue <> b then begin + modified := true; + diffB := Abs(blue - b); + if blue > b then + dec(blue, Min(step, diffB)) + else + inc(blue, Min(step, diffB)); + end; + + if modified then + SetColor(color, red, green, blue); + + FadeColor := ((red = r) and (green = g) and (blue = b)); +end; + +procedure FadeRangeToColor(colorStart, colorEnd, r, g, b: byte; + step: integer); +{ fades a range of colors in the current VGA color palette towards the + given RGB values. blocks, looping until the fade is complete. } +var + i : integer; + done : boolean; +begin + done := false; + step := Abs(step); + + while not done do begin + done := true; + WaitForVsync; + for i := colorStart to colorEnd do begin + if not FadeColor(i, r, g, b, step) then + done := false; + end; + end; +end; + +procedure FadeRangeToPalette(colorStart, colorEnd: byte; + const pal: PPalette; + step: integer); +{ fades a range of colors in the current VGA color palette towards the + given color palette. blocks, looping until the fade is complete. } +var + i : integer; + done : boolean; +begin + done := false; + step := Abs(step); + + while not done do begin + done := true; + WaitForVsync; + for i := colorStart to colorEnd do begin + if not FadeColor(i, pal^[i, 0], pal^[i, 1], pal^[i, 2], step) then + done := false; + end; + end; +end; + +function LoadFont(const filename: string; font: PFont) : FontResult; +{ loads a font from the given file, storing it in the Font instance + provided. returns FontOk on success. } +var + f : file; + x : integer; +label ioError; +begin + if font = nil then begin + LoadFont := FontBadArgs; + exit; + end; + + Assign(f, filename); + + Reset(f, 1); + if IOResult <> 0 then begin + Close(f); + x := IOResult; { clear i/o error flag } + LoadFont := FontNotFound; + exit; + end; + + { this font format is the same as the one DirectQB uses. it is a simple + format that i think works pretty well, so why not re-use it here ... } + + with font^ do begin + { standard BIOS-like format list of full ASCII 0-255 characters. + 8-bytes per character } + BlockRead(f, chars, SizeOf(BiosFontTable)); + if IOResult <> 0 then goto ioError; + + { 255 bytes, each byte representing the width of each ASCII character } + BlockRead(f, widths, SizeOf(BiosFontCharWidths)); + if IOResult <> 0 then goto ioError; + + { single byte, the global character height. that is, this is the max + height of any of the 256 ASCII characters in this font. will be <= 8 } + BlockRead(f, height, 1); + if IOResult <> 0 then goto ioError; + end; + + Close(f); + x := IOResult; { clear i/o error flag (just in case) } + LoadFont := FontOk; + exit; + +ioError: + Close(f); + x := IOResult; { clear i/o error flag } + LoadFont := FontIOError; +end; + +function LoadPalette(const filename: string; pal: PPalette) : FontResult; +begin +end; + +begin + if Test8086 < 2 then begin + writeln('The GDGFX unit requires a 386 cpu or higher!'); + halt; + end; +end. diff --git a/GDLIB/GDIFF.PAS b/GDLIB/GDIFF.PAS new file mode 100644 index 0000000..b4004af --- /dev/null +++ b/GDLIB/GDIFF.PAS @@ -0,0 +1,709 @@ +{ GDlib IFF (LBM, BBM) file load/save support. + Gered King, 2019 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDIFF; + +interface + +uses GDGfx; + +const IFF_DEFAULT = 0; +const IFF_UNCOMPRESSED = 1; +const IFF_INTERLEAVED = 2; + +type + IFFResult = (IFFNotFound, IFFIOError, IFFBadFile, IFFOk); + +function LoadIFFTo(const filename: string; pal: PPalette; dest: pointer; destPitch: word) : IFFResult; +function LoadIFFToBitmap(const filename: string; pal: PPalette; bmp: PBitmap) : IFFResult; +function LoadIFF(const filename: string; pal: PPalette) : IFFResult; +function SaveIFFFrom(const filename: string; pal: PPalette; src: pointer; srcWidth, srcHeight: word; format: byte) : IFFResult; +function SaveIFFFromBitmap(const filename: string; pal: PPalette; const bmp: PBitmap; format: byte) : IFFResult; +function SaveIFF(const filename: string; pal: PPalette; format: byte) : IFFResult; + +implementation + +uses Toolbox; + +const FORM_ID = (ord('F')) or (ord('O') shl 8) or (ord('R') shl 16) or (ord('M') shl 24); +const ILBM_ID = (ord('I')) or (ord('L') shl 8) or (ord('B') shl 16) or (ord('M') shl 24); +const PBM_ID = (ord('P')) or (ord('B') shl 8) or (ord('M') shl 16) or (ord(' ') shl 24); +const BMHD_ID = (ord('B')) or (ord('M') shl 8) or (ord('H') shl 16) or (ord('D') shl 24); +const CMAP_ID = (ord('C')) or (ord('M') shl 8) or (ord('A') shl 16) or (ord('P') shl 24); +const BODY_ID = (ord('B')) or (ord('O') shl 8) or (ord('D') shl 16) or (ord('Y') shl 24); + +type + IFFID = record + case Integer of + 0: (id: longint); + 1: (ch: array[0..3] of char); + end; + + FormChunkHeader = record + ChunkID : IFFID; + Size : longint; + TypeID : IFFID; + end; + + SubChunkHeader = record + ChunkID : IFFID; + Size : longint; + end; + + BMHDChunk = record + Width : word; + Height : word; + Left : word; + Top : word; + Bitplanes : byte; + Masking : byte; + Compress : byte; + Padding : byte; + Transparency : word; + XAspectRatio : byte; + YAspectRatio : byte; + PageWidth : word; + PageHeight : word; + end; + +procedure MergeBitplane(plane: integer; + src, dest: pointer; + rowSize: integer); +{ takes planar pixel data (for the specified plane only) from the source + pointer and merges into into existing "chunky" pixel data in the + destination pointer } +var + data, bitMask : byte; + srcArray, destArray : PByteArray; + x, i : integer; +begin + bitMask := (1 shl plane); + srcArray := PByteArray(src); + destArray := PByteArray(dest); + + for x := 0 to (rowSize-1) do begin + data := srcArray^[x]; + if (data and 128) > 0 then begin + i := x * 8; + destArray^[i] := destArray^[i] or bitMask; + end; + if (data and 64) > 0 then begin + i := x * 8 + 1; + destArray^[i] := destArray^[i] or bitMask; + end; + if (data and 32) > 0 then begin + i := x * 8 + 2; + destArray^[i] := destArray^[i] or bitMask; + end; + if (data and 16) > 0 then begin + i := x * 8 + 3; + destArray^[i] := destArray^[i] or bitMask; + end; + if (data and 8) > 0 then begin + i := x * 8 + 4; + destArray^[i] := destArray^[i] or bitMask; + end; + if (data and 4) > 0 then begin + i := x * 8 + 5; + destArray^[i] := destArray^[i] or bitMask; + end; + if (data and 2) > 0 then begin + i := x * 8 + 6; + destArray^[i] := destArray^[i] or bitMask; + end; + if (data and 1) > 0 then begin + i := x * 8 + 7; + destArray^[i] := destArray^[i] or bitMask; + end; + end; +end; + +procedure ExtractBitplane(plane: integer; + src, dest: pointer; + rowSize: integer); +{ takes "chunky" pixel data from the source pointer, and extracts planar + pixel data from it, from the specified plane only, storing it at the + destination pointer } +var + data, bitMask : byte; + srcArray, destArray : PByteArray; + x, i : integer; +begin + bitMask := (1 shl plane); + srcArray := PByteArray(src); + destArray := PByteArray(dest); + + i := 0; + for x := 0 to (rowSize-1) do begin + data := 0; + if (srcArray^[i] and bitMask) <> 0 then + data := (data or 128); + if (srcArray^[i+1] and bitMask) <> 0 then + data := (data or 64); + if (srcArray^[i+2] and bitMask) <> 0 then + data := (data or 32); + if (srcArray^[i+3] and bitMask) <> 0 then + data := (data or 16); + if (srcArray^[i+4] and bitMask) <> 0 then + data := (data or 8); + if (srcArray^[i+5] and bitMask) <> 0 then + data := (data or 4); + if (srcArray^[i+6] and bitMask) <> 0 then + data := (data or 2); + if (srcArray^[i+7] and bitMask) <> 0 then + data := (data or 1); + + inc(i, 8); + destArray^[x] := data; + end; +end; + +function LoadBODYPlanar(var f: file; + const bmhd: BMHDChunk; + dest: pointer; + destPitch: word) : boolean; +{ loads an interleaved (planar) ILBM-format BODY chunk. automatically + handles compressed or uncompressed formats. } +var + p : ^byte; + rowBytes : word; + i, y : integer; + plane : integer; + buffer : array[0..(((SCREEN_WIDTH + 15) shr 4) shl 1)-1] of byte; +label ioError; +begin + p := dest; + rowBytes := ((bmhd.Width + 15) shr 4) shl 1; + + for y := 0 to (bmhd.Height-1) do begin + { planar data is stored for each bitplane in sequence for the scanline. + that is, ALL of bitplane1, followed by ALL of bitplane2, etc, NOT + alternating after each pixel. if compression is enabled, it does NOT + cross bitplane boundaries. each bitplane is compressed individually. + bitplanes also do NOT cross the scanline boundary. basically, each + scanline of pixel data, and within that, each of the bitplanes of + pixel data found in each scanline can all be treated as they are all + their own self-contained bit of data as far as this loading process + is concerned (well, except that we merge all of the scanline's + bitplanes together at the end of each line) } + + { read all the bitplane rows per scanline } + for plane := 0 to (bmhd.Bitplanes-1) do begin + if bmhd.Compress = 1 then begin + { decompress packed line for this bitplane only } + if (not UnpackBytes(f, @buffer, rowBytes)) then + goto ioError; + + { or, if not compressed } + end else begin + { TODO: check this. maybe rowBytes is wrong. i don't think DP2 or + GRAFX2 ever output uncompressed interleaved files anyway. } + { just read all this bitplane's line data in as-is } + BlockRead(f, buffer[0], rowBytes); + if IOResult <> 0 then goto ioError; + + end; + + { merge this bitplane data into the final destination. after all of + the bitplanes have been loaded and merged in this way for this + scanline, the destination pointer will contain VGA-friendly + "chunky pixel"-format pixel data. } + MergeBitplane(plane, @buffer, p, rowBytes); + end; + + inc(p, destPitch); + end; + + LoadBODYPlanar := true; + exit; + +ioError: + LoadBODYPlanar := false; +end; + +function LoadBODYChunky(var f: file; + const bmhd: BMHDChunk; + dest: pointer; + destPitch: word) : boolean; +{ loads a PBM-format BODY chunk. reads it in compressed or uncompressed + format depending on the BMHD chunk provided } +var + p : ^byte; + data : byte; + n, x, y : integer; + count : integer; + rawBuffer : array[0..SCREEN_RIGHT] of byte; +label ioError; +begin + p := dest; + for y := 0 to (bmhd.Height-1) do begin + if bmhd.Compress = 1 then begin + { for compression-enabled, read row of pixels using PackBits } + if (not UnpackBytes(f, p, bmhd.Width)) then + goto ioError; + inc(p, bmhd.Width + (destPitch - bmhd.Width)); + + end else begin + { for uncompressed, read row of pixels literally } + x := 0; + while x < bmhd.Width do begin + { continously load buffer-size (or less) pixel chunks from this + scanline and copy to destination as-is } + count := bmhd.Width - x; + if count > sizeof(rawBuffer) then + count := sizeof(rawBuffer); + + BlockRead(f, rawBuffer, count); + if IOResult <> 0 then goto ioError; + + MemCopy(p, @rawBuffer, count); + inc(p, count); + inc(x, count); + end; + inc(p, (destPitch - bmhd.Width)); + end; + + end; + + LoadBODYChunky := true; + exit; + +ioError: + LoadBODYChunky := false; +end; + +function LoadIFFTo(const filename: string; + pal: PPalette; + dest: pointer; + destPitch: word) : IFFResult; +{ loads an IFF file, storing the loaded pixel data at the pointer given. + both compressed and uncompressed files using either planar/interleaved + (ILBM) or chunky (PBM) pixel formats are supported. if a palette is + provided, the palette data from the IFF file will also be loaded. + returns IFFOk if successful. } +var + f : file; + form : FormChunkHeader; + header : SubChunkHeader; + bmhd : BMHDChunk; + i, n : integer; + chunkDataPos : longint; + result, chunky : boolean; +label ioError; +begin + Assign(f, filename); + + Reset(f, 1); + if IOResult <> 0 then begin + Close(f); + n := IOResult; { clear i/o error flag } + LoadIFFTo := IFFNotFound; + exit; + end; + + { read "FORM" chunk header } + BlockRead(f, form, SizeOf(FormChunkHeader)); + if IOResult <> 0 then goto ioError; + form.Size := ByteFlipDWord(form.Size); + + { only supporting "ILBM" and "PBM" types } + if (form.ChunkID.id <> FORM_ID) + or ((form.TypeID.id <> ILBM_ID) + and (form.TypeID.id <> PBM_ID)) then begin + Close(f); + LoadIFFTo := IFFBadFile; + exit; + end; + + chunky := (form.TypeID.id = PBM_ID); + + { chunks can apparently appear in any order, so loop until we've read + everything that we need. + the one exception (maybe??) is that "BODY" chunks should normally occur + before the only other chunks we care about. } + while (not eof(f)) do begin + { read next subchunk header } + BlockRead(f, header, SizeOf(SubChunkHeader)); + if IOResult <> 0 then goto ioError; + + header.Size := ByteFlipDWord(header.Size); + if (header.Size and 1) = 1 then + inc(header.Size); { account for padding byte } + + chunkDataPos := FilePos(f); + + { bitmap header chunk } + if header.ChunkID.id = BMHD_ID then begin + BlockRead(f, bmhd, SizeOf(BMHDChunk)); + if IOResult <> 0 then goto ioError; + + bmhd.Width := ByteFlipWord(bmhd.Width); + bmhd.Height := ByteFlipWord(bmhd.Height); + bmhd.Left := ByteFlipWord(bmhd.Left); + bmhd.Top := ByteFlipWord(bmhd.Top); + bmhd.Transparency := ByteFlipWord(bmhd.Transparency); + bmhd.PageWidth := ByteFlipWord(bmhd.PageWidth); + bmhd.PageHeight := ByteFlipWord(bmhd.PageHeight); + + { only supporting 8-bit without masking } + if (bmhd.Bitplanes <> 8) + or (bmhd.Masking = 1) then begin + Close(f); + LoadIFFTo := IFFBadFile; + exit; + end; + + { color map (aka palette) chunk } + end else if header.ChunkID.id = CMAP_ID then begin + if pal <> nil then begin + { we're only supporting 256 color palettes } + if header.Size <> 768 then begin + Close(f); + LoadIFFTo := IFFBadFile; + exit; + end; + + BlockRead(f, pal^, SizeOf(Palette)); + if IOResult <> 0 then goto ioError; + + { convert from 0-255 RGB to VGA RGB format (0-63) } + for i := 0 to 255 do begin + pal^[i, 0] := pal^[i, 0] shr 2; + pal^[i, 1] := pal^[i, 1] shr 2; + pal^[i, 2] := pal^[i, 2] shr 2; + end; + end; + + { body chunk, where all the magic happens } + end else if header.ChunkID.id = BODY_ID then begin + if not chunky then + result := LoadBODYPlanar(f, bmhd, dest, destPitch) + else + result := LoadBODYChunky(f, bmhd, dest, destPitch); + + if not result then goto ioError; + end; + + { move to start of next chunk } + Seek(f, chunkDataPos + header.Size); + end; + + Close(f); + n := IOResult; { clear i/o error flag (just in case) } + LoadIFFTo := IFFOk; + exit; + +ioError: + Close(f); + n := IOResult; { clear i/o error flag } + LoadIFFTo := IFFIOError; +end; + +function LoadIFFToBitmap(const filename: string; + pal: PPalette; + bmp: PBitmap) : IFFResult; +{ loads an IFF file onto the given bitmap. both compressed and uncompressed + files using either planar/interleaved (ILBM) or chunky (PBM) pixel formats + are supported. the destination bitmap should be pre-allocated to a size + sufficient to hold the IFF file being loaded. if a palette is provided, + the palette data from the IFF file will also be loaded. returns IFFOk if + successful. } +var + dest : pointer; +begin + dest := @bmp^.Pixels; + LoadIFFToBitmap := LoadIFFTo(filename, pal, dest, bmp^.Width); +end; + +function LoadIFF(const filename: string; + pal: PPalette) : IFFResult; +{ loads an IFF file onto the currently bound layer. both compressed and + uncompressed files using either planar/interleaved (ILBM) or chunky (PBM) + pixel formats are supported. the IFF file being loaded should not contain + an image larger then 320x200. if a palette is provided, the palette data + from the IFF file will also be loaded. returns IFFOk if successful. } +var + dest : pointer; +begin + dest := ptr(GetBoundLayerSegment, GetBoundLayerOffset); + LoadIFF := LoadIFFTo(filename, pal, dest, SCREEN_WIDTH); +end; + +function WriteBODYPlanar(var f: file; + const bmhd: BMHDChunk; + src: pointer; + srcPitch: word) : boolean; +{ writes a compressed interleaved (planar) ILBM-format BODY chunk } +var + p : ^byte; + width, height : integer; + y, plane : integer; + rowBytes : word; + buffer : array[0..(((SCREEN_WIDTH + 15) shr 4) shl 1)-1] of byte; +label ioError; +begin + p := src; + width := ByteFlipWord(bmhd.Width); + height := ByteFlipWord(bmhd.Height); + rowBytes := ((width + 15) shr 4) shl 1; + + for y := 0 to (height-1) do begin + for plane := 0 to (bmhd.Bitplanes-1) do begin + ExtractBitplane(plane, p, @buffer, rowBytes); + + if bmhd.Compress = 1 then begin + { for compression-enabled, write this plane's pixels using PackBits } + if (not PackBytes(@buffer, f, rowBytes)) then + goto ioError; + end else begin + { TODO: check this. maybe rowBytes is wrong. i don't think DP2 or + GRAFX2 ever output uncompressed interleaved files anyway. } + { for uncompressed, write this plane's pixels literally } + MemCopy(@buffer, p, rowBytes); + BlockWrite(f, buffer, rowBytes); + if IOResult <> 0 then goto ioError; + end; + end; + + inc(p, width + (srcPitch - width)); + end; + + WriteBODYPlanar := true; + exit; + +ioError: + WriteBODYPlanar := false; +end; + +function WriteBODYChunky(var f: file; + const bmhd: BMHDChunk; + src: pointer; + srcPitch: word) : boolean; +{ writes a PBM-format BODY chunk. writes it in compressed or uncompressed + format depending on the BMHD chunk provided } +var + p : ^byte; + y, width, height : integer; + buffer : array[0..SCREEN_RIGHT] of byte; +label ioError; +begin + p := src; + width := ByteFlipWord(bmhd.Width); + height := ByteFlipWord(bmhd.Height); + + for y := 0 to (height-1) do begin + if bmhd.Compress = 1 then begin + { for compression-enabled, write row of pixels using PackBits } + if (not PackBytes(p, f, width)) then + goto ioError; + + end else begin + { for uncompressed, write out the row of pixels literally } + MemCopy(@buffer, p, width); + BlockWrite(f, buffer, width); + if IOResult <> 0 then goto ioError; + end; + + inc(p, width + (srcPitch - width)); + end; + + WriteBODYChunky := true; + exit; + +ioError: + WriteBODYChunky := false; +end; + +function SaveIFFFrom(const filename: string; + pal: PPalette; + src: pointer; + srcWidth, srcHeight: word; + format: byte) : IFFResult; +{ saves the pixel data located at the given pointer (with the given + dimensions) to an IFF file. if a palette is provided, that palette is saved + to the file, otherwise the current VGA palette is saved instead. returns + IFFOk if successful. } +var + f : file; + form : FormChunkHeader; + header : SubChunkHeader; + bmhd : BMHDChunk; + i, n : integer; + b : byte; + fileSizePos : longint; + bodySizePos : longint; + eofPos : longint; + sizeBuffer : longint; + rgb : array[0..2] of Color; + result, compress, chunky : boolean; +label ioError; +begin + if format = IFF_DEFAULT then begin + chunky := true; + compress := true; + end else begin + chunky := (format and IFF_INTERLEAVED) = 0; + compress := (format and IFF_UNCOMPRESSED) = 0; + end; + + Assign(f, filename); + + Rewrite(f, 1); + if IOResult <> 0 then goto ioError; + + { write IFF "FORM" chunk header } + form.ChunkID.id := FORM_ID; + form.Size := 0; { will fill this in at the end } + if chunky then + form.TypeID.id := PBM_ID + else + form.TypeID.id := ILBM_ID; + + { this is the position we need to come back to at the very end, and write + the final file size to } + fileSizePos := 4; + + BlockWrite(f, form, SizeOf(FormChunkHeader)); + if IOResult <> 0 then goto ioError; + + { write "BMHD" chunk } + header.ChunkID.id := BMHD_ID; + header.Size := ByteFlipDWord(SizeOf(BMHDChunk)); + BlockWrite(f, header, SizeOf(SubChunkHeader)); + if IOResult <> 0 then goto ioError; + + bmhd.Width := ByteFlipWord(srcWidth); + bmhd.Height := ByteFlipWord(srcHeight); + bmhd.Left := 0; + bmhd.Top := 0; + bmhd.Bitplanes := 8; + bmhd.Masking := 0; + if compress then bmhd.Compress := 1 else bmhd.Compress := 0; + bmhd.Padding := 0; + bmhd.Transparency := 0; + bmhd.XAspectRatio := 5; { this is what DP2 writes for 320x200. meh. } + bmhd.YAspectRatio := 6; + bmhd.PageWidth := ByteFlipWord(320); + bmhd.PageHeight := ByteFlipWord(200); + BlockWrite(f, bmhd, SizeOf(BMHDChunk)); + if IOResult <> 0 then goto ioError; + + { write "CMAP" chunk } + header.ChunkID.id := CMAP_ID; + header.Size := ByteFlipDWord(768); + BlockWrite(f, header, SizeOf(SubChunkHeader)); + if IOResult <> 0 then goto ioError; + + { write out provided palette, or the current VGA palette } + if pal <> nil then begin + for i := 0 to 255 do begin + rgb[0] := pal^[i, 0] shl 2; + rgb[1] := pal^[i, 1] shl 2; + rgb[2] := pal^[i, 2] shl 2; + BlockWrite(f, rgb, 3); + if IOResult <> 0 then goto ioError; + end; + + end else begin + for i := 0 to 255 do begin + GetColor(i, rgb[0], rgb[1], rgb[2]); + + rgb[0] := rgb[0] shl 2; + rgb[1] := rgb[1] shl 2; + rgb[2] := rgb[2] shl 2; + + BlockWrite(f, rgb, 3); + if IOResult <> 0 then goto ioError; + end; + end; + + { write "BODY" chunk } + header.ChunkID.id := BODY_ID; + header.Size := 0; { will come back and write this at the end } + + { save the position we need to come back to, to write the "BODY" chunk + size at } + bodySizePos := FilePos(f) + SizeOf(IFFID); + + BlockWrite(f, header, SizeOf(SubChunkHeader)); + if IOResult <> 0 then goto ioError; + + if chunky then + result := WriteBODYChunky(f, bmhd, src, SCREEN_WIDTH) + else + result := WriteBODYPlanar(f, bmhd, src, SCREEN_WIDTH); + if not result then goto ioError; + + eofPos := FilePos(f); + { write a chunk body padding byte if needed } + if (eofPos and 1) = 1 then begin + b := 0; + BlockWrite(f, b, 1); + if IOResult <> 0 then goto ioError; + + inc(eofPos); + end; + + { "BODY" chunk header size } + Seek(f, bodySizePos); + sizeBuffer := ByteFlipDWord((eofPos - bodySizePos - 4)); + BlockWrite(f, sizeBuffer, 4); + if IOResult <> 0 then goto ioError; + + { IFF "FORM" chunk header size } + Seek(f, fileSizePos); + sizeBuffer := ByteFlipDWord(eofPos - 8); + BlockWrite(f, sizeBuffer, 4); + if IOResult <> 0 then goto ioError; + + Close(f); + n := IOResult; { clear i/o error flag (just in case) } + SaveIFFFrom := IFFOk; + exit; + +ioError: + Close(f); + n := IOResult; { clear i/o error flag } + SaveIFFFrom := IFFIOError; +end; + +function SaveIFFFromBitmap(const filename: string; + pal: PPalette; + const bmp: PBitmap; + format: byte) : IFFResult; +{ saves the specified bitmap to an IFF file. if a palette is provided, that + palette is saved to the file, otherwise the current VGA palette is saved + instead. returns IFFOk if successful. } +var + src : pointer; +begin + src := @bmp^.Pixels; + SaveIFFFromBitmap := SaveIFFFrom(filename, + pal, + src, + bmp^.Width, + bmp^.Height, + format); +end; + +function SaveIFF(const filename: string; + pal: PPalette; + format: byte) : IFFResult; +{ saves the currently bound layer to an IFF file. if a palette is provided, + that palette is saved to the file, otherwise the current VGA palette is + saved instead. returns IFFOk if successful. } +var + src : pointer; +begin + src := ptr(GetBoundLayerSegment, GetBoundLayerOffset); + SaveIFF := SaveIFFFrom(filename, + pal, + src, + SCREEN_WIDTH, + SCREEN_HEIGHT, + format); +end; + +end. diff --git a/GDLIB/GDKEYBRD.PAS b/GDLIB/GDKEYBRD.PAS new file mode 100644 index 0000000..7ef74f8 --- /dev/null +++ b/GDLIB/GDKEYBRD.PAS @@ -0,0 +1,417 @@ +{ GDlib Keyboard Handler + Gered King, 2018 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDKeybrd; + +interface + +const + KEY_ESC = $01; + KEY_1 = $02; + KEY_2 = $03; + KEY_3 = $04; + KEY_4 = $05; + KEY_5 = $06; + KEY_6 = $07; + KEY_7 = $08; + KEY_8 = $09; + KEY_9 = $0a; + KEY_0 = $0b; + KEY_MINUS = $0c; + KEY_EQUALS = $0d; + KEY_BACKSPACE = $0e; + KEY_TAB = $0f; + KEY_Q = $10; + KEY_W = $11; + KEY_E = $12; + KEY_R = $13; + KEY_T = $14; + KEY_Y = $15; + KEY_U = $16; + KEY_I = $17; + KEY_O = $18; + KEY_P = $19; + KEY_LEFT_BRACKET = $1a; + KEY_RIGHT_BRACKET = $1b; + KEY_ENTER = $1c; + KEY_CTRL = $1d; + KEY_A = $1e; + KEY_S = $1f; + KEY_D = $20; + KEY_F = $21; + KEY_G = $22; + KEY_H = $23; + KEY_J = $24; + KEY_K = $25; + KEY_L = $26; + KEY_SEMICOLON = $27; + KEY_APOSTROPHE = $28; + KEY_TILDE = $29; + KEY_LEFT_SHIFT = $2a; + KEY_BACKSLASH = $2b; + KEY_Z = $2c; + KEY_X = $2d; + KEY_C = $2e; + KEY_V = $2f; + KEY_B = $30; + KEY_N = $31; + KEY_M = $32; + KEY_COMMA = $33; + KEY_PERIOD = $34; + KEY_FORWARDSLASH = $35; + KEY_RIGHT_SHIFT = $36; + KEY_ASTERISK = $37; + KEY_ALT = $38; + KEY_SPACE = $39; + KEY_CAPS_LOCK = $3a; + KEY_F1 = $3b; + KEY_F2 = $3c; + KEY_F3 = $3d; + KEY_F4 = $3e; + KEY_F5 = $3f; + KEY_F6 = $40; + KEY_F7 = $41; + KEY_F8 = $42; + KEY_F9 = $43; + KEY_F10 = $44; + KEY_NUM_LOCK = $45; + KEY_SCROLL_LOCK = $46; + KEY_HOME = $47; + KEY_UP = $48; + KEY_PAGE_UP = $49; + KEY_NUM_MINUS = $4a; + KEY_LEFT = $4b; + KEY_NUM_5 = $4c; + KEY_RIGHT = $4d; + KEY_NUM_PLUS = $4e; + KEY_END = $4f; + KEY_DOWN = $50; + KEY_PAGE_DOWN = $51; + KEY_INSERT = $52; + KEY_DELETE = $53; + KEY_F11 = $57; + KEY_F12 = $58; + + KB_FLAGS_SCROLL_LOCK = $10; + KB_FLAGS_NUM_LOCK = $20; + KB_FLAGS_CAPS_LOCK = $40; + + KB_MOD_EXTENDED = $01; + KB_MOD_SHIFT = $02; + KB_MOD_NUM_LOCK = $04; + KB_MOD_CAPS_LOCK = $08; + +type + Key = byte; + +var + Keys : array[0..127] of bytebool; + KeybrdFlags : word absolute $0040:$0017; + KeyFlags : word; + KeyMod : word; + +function InitKeyboard : boolean; +function CloseKeyboard : boolean; +function IsKeyboardInitialized : boolean; +function WaitForAnyKey : Key; +procedure WaitForNoKeys; +procedure WaitForKey(k: Key); +procedure WaitUntilKeyNotPressed(k: Key); + +implementation + +uses Dos, GDEvents, Toolbox; + +const + PIC_CTRL_PORT = $20; + KBRD_DATA_PORT = $60; + KBRD_CTRL_PORT = $61; + KBRD_STATUS_PORT = $64; + KBRD_CMD_SET_LED = $ed; + KBRD_LED_SCROLL_LOCK = $01; + KBRD_LED_NUM_LOCK = $02; + KBRD_LED_CAPS_LOCK = $04; + KEY_EXTENDED = $e0; + + _KeyboardInstalled : boolean = false; + +var + _keyLastScan : Key; + _keyScan : Key; + _oldKeybrdInterrupt : pointer; + _keyboardEvent : PInputEvent; + +procedure ResetKeyState; +begin + _keyLastScan := 0; + _keyScan := 0; + KeyFlags := 0; + KeyMod := 0; + MemFill(@Keys, 0, 128); +end; + +procedure WaitKeybrdDataRead; +{ waits until the keyboard status port indicates the data port can be + read from once again } +begin + while (port[KBRD_STATUS_PORT] and 1) = 0 do begin + end; +end; + +procedure WaitKeybrdDataWrite; +{ waits until the keyboard status port indicates the data port can be + written to once again } +begin + while (port[KBRD_STATUS_PORT] and 2) <> 0 do begin + end; +end; + +function SendKeybrdData(data: byte) : boolean; +{ sends data to the keyboard data port. checks for success and returns + true if the data write succeeded } +var + result: byte; +begin + WaitKeybrdDataWrite; + port[KBRD_DATA_PORT] := data; + + WaitKeybrdDataRead; + result := port[KBRD_DATA_PORT]; + + SendKeybrdData := (result = $fa); +end; + +function UpdateKeybrdLED(flags: byte) : boolean; +{ updates the keyboard indicator LEDs from the num/caps/scroll lock flags + provided. returns false if the LEDs could not be updated (if the writes + to the keyboard data port fail for any reason). } +var + data: byte; +begin + UpdateKeybrdLED := false; + + if not SendKeybrdData(KBRD_CMD_SET_LED) then + exit; + + data := (flags shr 4) and 7; { restrict to only the 3 led flags } + if not SendKeybrdData(data) then + exit; + + UpdateKeybrdLED := true; +end; + +procedure PushKeyboardEvent(key: Key; action: EventAction); +begin + if not IsEventsInitialized then + exit; + + _keyboardEvent := PushEvent; + + with _keyboardEvent^ do begin + Event := EVENT_TYPE_KEYBOARD; + KB_Key := key; + KB_Action := action; + KB_Modifier := KeyMod; + end; +end; + +function HandlerFilterKeys : boolean; +{ returns true if the key interrupt event should not be handled (at least + as far as updating key state is concerned) } +begin + HandlerFilterKeys := false; + + if (KeyMod and KB_MOD_EXTENDED) <> 0 then begin + { extended key + leftshift comes with cursor key presses when + numlock is enabled ... } + if (_keyScan and $7f) = KEY_LEFT_SHIFT then + HandlerFilterKeys := true; + end; +end; + +procedure HandlerUpdateFlagsAndLEDs; +{ maintains BIOS keyboard flags/led toggle states (caps/num/scroll lock) } +begin + case _keyScan of + KEY_CAPS_LOCK: begin + KeyFlags := KeyFlags xor KB_FLAGS_CAPS_LOCK; + UpdateKeybrdLED(KeyFlags); + KeybrdFlags := KeyFlags; + end; + KEY_NUM_LOCK: begin + KeyFlags := KeyFlags xor KB_FLAGS_NUM_LOCK; + UpdateKeybrdLED(KeyFlags); + KeybrdFlags := KeyFlags; + end; + KEY_SCROLL_LOCK: begin + KeyFlags := KeyFlags xor KB_FLAGS_SCROLL_LOCK; + UpdateKeybrdLED(KeyFlags); + KeybrdFlags := KeyFlags; + end; + end; +end; + +procedure HandlerUpdateModifiers; +begin + if (KeyFlags and KB_FLAGS_NUM_LOCK) <> 0 then + KeyMod := KeyMod or KB_MOD_NUM_LOCK + else + KeyMod := KeyMod and not KB_MOD_NUM_LOCK; + + if (KeyFlags and KB_FLAGS_CAPS_LOCK) <> 0 then + KeyMod := KeyMod or KB_MOD_CAPS_LOCK + else + KeyMod := KeyMod and not KB_MOD_CAPS_LOCK; + + if Keys[KEY_LEFT_SHIFT] or Keys[KEY_RIGHT_SHIFT] then + KeyMod := KeyMod or KB_MOD_SHIFT + else + KeyMod := KeyMod and not KB_MOD_SHIFT; +end; + +procedure KeybrdHandler; +{ custom keyboard interrupt handler. called on every keyboard event } +interrupt; +begin + { read scan code of key that was just pressed (or released) } + _keyScan := port[KBRD_DATA_PORT]; + + { handle updating key state and flags/modifiers } + if _keyScan = KEY_EXTENDED then begin + KeyMod := KeyMod or KB_MOD_EXTENDED; + + end else begin + if not HandlerFilterKeys then begin + if (_keyScan and $80) <> 0 then begin + { high bit set indicates key was released. clear high bit to get + the actual key scan code } + _keyScan := _keyScan and $7f; + Keys[_keyScan] := false; + HandlerUpdateModifiers; + PushKeyboardEvent(_keyScan, EVENT_ACTION_RELEASED); + + end else begin + if Keys[_keyScan] then begin + PushKeyboardEvent(_keyScan, EVENT_ACTION_HELD); + + end else begin + Keys[_keyScan] := true; + { toggling of states only needs to be done for a key down event } + HandlerUpdateFlagsAndLEDs; + HandlerUpdateModifiers; + + PushKeyboardEvent(_keyScan, EVENT_ACTION_PRESSED); + end; + + end; + + _keyLastScan := _keyScan; + end; + + { clear extended modifier for the following event(s) in any case } + KeyMod := KeyMod and not KB_MOD_EXTENDED; + + end; + + { indicate key event was processed to the keyboard controller } + _keyScan := (port[KBRD_CTRL_PORT] or $80); + port[KBRD_CTRL_PORT] := _keyScan; + port[KBRD_CTRL_PORT] := (_keyScan and $7f); + port[PIC_CTRL_PORT] := $20; +end; + +function InitKeyboard : boolean; +{ installs a custom keyboard interrupt handler. returns false if the + keyboard interrupt handler could not be installed for some reason, or if + the custom handler was already installed. } +begin + if _keyboardInstalled then begin + InitKeyboard := false; + exit; + end; + + ResetKeyState; + + KeyFlags := KeybrdFlags; + { bad hacky way to maybe-sortof-possibly not get into weird states + depending on what keys are held down as this executes. + a proper fix would involve updating our key handler to handle ALL + of the bios key flag bits. } + KeyFlags := KeyFlags and not $f38f; + HandlerUpdateModifiers; + GetIntVec(9, _oldKeybrdInterrupt); + SetIntVec(9, @KeybrdHandler); + KeybrdFlags := KeyFlags; + + _keyboardInstalled := true; + InitKeyboard := true; +end; + +function CloseKeyboard : boolean; +{ removes a previously installed custom keyboard interrupt handler. } +begin + if not _keyboardInstalled then begin + CloseKeyboard := true; + exit; + end; + + SetIntVec(9, _oldKeybrdInterrupt); + ResetKeyState; + + _keyboardInstalled := false; + CloseKeyboard := true; +end; + +function IsKeyboardInitialized : boolean; +{ returns true if our custom keyboard handler has been initialized } +begin + IsKeyboardInitialized := _keyboardInstalled; +end; + +function WaitForAnyKey : Key; +{ waits indefinitely until any key is pressed, and returns the key scan code + of the key that was pressed. } +begin + _keyLastScan := 0; + while _keyLastScan = 0 do begin + end; + WaitForAnyKey := _keyLastScan; +end; + +procedure WaitForNoKeys; +{ waits indefinitely until there are no keys pressed. } +var + i : word; + foundPressed : boolean; +begin + repeat + foundPressed := false; + for i := 0 to 127 do begin + if Keys[i] then begin + foundPressed := true; + break; + end; + end; + until (not foundPressed); +end; + +procedure WaitForKey(k: Key); +{ waits indefinitely until the specified key is pressed } +begin + _keyLastScan := 0; + while _keyLastScan <> k do begin + end; +end; + +procedure WaitUntilKeyNotPressed(k: Key); +{ waits indefinitely until the specified key is not pressed } +begin + while Keys[k] do begin + end; +end; + +begin + MemFill(@Keys, 0, SizeOf(Keys)); +end. diff --git a/GDLIB/GDKEYCHR.PAS b/GDLIB/GDKEYCHR.PAS new file mode 100644 index 0000000..ce5158f --- /dev/null +++ b/GDLIB/GDKEYCHR.PAS @@ -0,0 +1,192 @@ +{ GDlib Keyboard Handler - Keycode-to-Char Conversion Support + Gered King, 2020 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDKeyChr; + +interface + +uses GDKeybrd; + +function KeyToChar(k: Key; modifiers: word) : char; + +implementation + +const + + LookupKeyToChar : array[0..127] of char = ( + #0, #0, '1', '2', '3', '4', '5', '6', { 00 - 07 } + '7', '8', '9', '0', '-', '=', #0, #9, { 08 - 0f } + 'q', 'w', 'e', 'r', 't', 'y', 'u', 'i', { 10 - 17 } + 'o', 'p', '[', ']', #0, #0, 'a', 's', { 18 - 1f } + 'd', 'f', 'g', 'h', 'j', 'k', 'l', ';', { 20 - 27 } + '''', '`', #0, '\', 'z', 'x', 'c', 'v', { 28 - 2f } + 'b', 'n', 'm', ',', '.', '/', #0, '*', { 30 - 37 } + #0, ' ', #0, #0, #0, #0, #0, #0, { 38 - 3f } + #0, #0, #0, #0, #0, #0, #0, #0, { 40 - 47 } + #0, #0, #0, #0, #0, #0, #0, #0, { 48 - 4f } + #0, #0, #0, #0, #0, #0, #0, #0, { 50 - 57 } + #0, #0, #0, #0, #0, #0, #0, #0, { 58 - 5f } + #0, #0, #0, #0, #0, #0, #0, #0, { 60 - 67 } + #0, #0, #0, #0, #0, #0, #0, #0, { 68 - 6f } + #0, #0, #0, #0, #0, #0, #0, #0, { 70 - 77 } + #0, #0, #0, #0, #0, #0, #0, #0 { 78 - 7f } + ); + + LookupKeyToCharShift : array[0..127] of char = ( + #0, #0, '!', '@', '#', '$', '%', '^', { 00 - 07 } + '&', '*', '(', ')', '_', '+', #0, #9, { 08 - 0f } + 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', { 10 - 17 } + 'O', 'P', '{', '}', #0, #0, 'A', 'S', { 18 - 1f } + 'D', 'F', 'G', 'H', 'J', 'K', 'L', ':', { 20 - 27 } + '"', '~', #0, '|', 'Z', 'X', 'C', 'V', { 28 - 2f } + 'B', 'N', 'M', '<', '>', '?', #0, '*', { 30 - 37 } + #0, ' ', #0, #0, #0, #0, #0, #0, { 38 - 3f } + #0, #0, #0, #0, #0, #0, #0, #0, { 40 - 47 } + #0, #0, #0, #0, #0, #0, #0, #0, { 48 - 4f } + #0, #0, #0, #0, #0, #0, #0, #0, { 50 - 57 } + #0, #0, #0, #0, #0, #0, #0, #0, { 58 - 5f } + #0, #0, #0, #0, #0, #0, #0, #0, { 60 - 67 } + #0, #0, #0, #0, #0, #0, #0, #0, { 68 - 6f } + #0, #0, #0, #0, #0, #0, #0, #0, { 70 - 77 } + #0, #0, #0, #0, #0, #0, #0, #0 { 78 - 7f } + ); + + LookupKeyToCharCaps : array[0..127] of char = ( + #0, #0, '1', '2', '3', '4', '5', '6', { 00 - 07 } + '7', '8', '9', '0', '-', '=', #0, #9, { 08 - 0f } + 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', { 10 - 17 } + 'O', 'P', '[', ']', #0, #0, 'A', 'S', { 18 - 1f } + 'D', 'F', 'G', 'H', 'J', 'K', 'L', ';', { 20 - 27 } + '''', '`', #0, '\', 'Z', 'X', 'C', 'V', { 28 - 2f } + 'B', 'N', 'M', ',', '.', '/', #0, '*', { 30 - 37 } + #0, ' ', #0, #0, #0, #0, #0, #0, { 38 - 3f } + #0, #0, #0, #0, #0, #0, #0, #0, { 40 - 47 } + #0, #0, #0, #0, #0, #0, #0, #0, { 48 - 4f } + #0, #0, #0, #0, #0, #0, #0, #0, { 50 - 57 } + #0, #0, #0, #0, #0, #0, #0, #0, { 58 - 5f } + #0, #0, #0, #0, #0, #0, #0, #0, { 60 - 67 } + #0, #0, #0, #0, #0, #0, #0, #0, { 68 - 6f } + #0, #0, #0, #0, #0, #0, #0, #0, { 70 - 77 } + #0, #0, #0, #0, #0, #0, #0, #0 { 78 - 7f } + ); + + LookupKeyToCharCapsShift : array[0..127] of char = ( + #0, #0, '!', '@', '#', '$', '%', '^', { 00 - 07 } + '&', '*', '(', ')', '_', '+', #0, #9, { 08 - 0f } + 'q', 'w', 'e', 'r', 't', 'y', 'u', 'i', { 10 - 17 } + 'o', 'p', '{', '}', #0, #0, 'a', 's', { 18 - 1f } + 'd', 'f', 'g', 'h', 'j', 'k', 'l', ':', { 20 - 27 } + '"', '~', #0, '|', 'z', 'x', 'c', 'v', { 28 - 2f } + 'b', 'n', 'm', '<', '>', '?', #0, '*', { 30 - 37 } + #0, ' ', #0, #0, #0, #0, #0, #0, { 38 - 3f } + #0, #0, #0, #0, #0, #0, #0, #0, { 40 - 47 } + #0, #0, #0, #0, #0, #0, #0, #0, { 48 - 4f } + #0, #0, #0, #0, #0, #0, #0, #0, { 50 - 57 } + #0, #0, #0, #0, #0, #0, #0, #0, { 58 - 5f } + #0, #0, #0, #0, #0, #0, #0, #0, { 60 - 67 } + #0, #0, #0, #0, #0, #0, #0, #0, { 68 - 6f } + #0, #0, #0, #0, #0, #0, #0, #0, { 70 - 77 } + #0, #0, #0, #0, #0, #0, #0, #0 { 78 - 7f } + ); + + LookupKeyToCharNumpad : array[0..127] of char = ( + #0, #0, #0, #0, #0, #0, #0, #0, { 00 - 07 } + #0, #0, #0, #0, #0, #0, #0, #0, { 08 - 0f } + #0, #0, #0, #0, #0, #0, #0, #0, { 10 - 17 } + #0, #0, #0, #0, #0, #0, #0, #0, { 18 - 1f } + #0, #0, #0, #0, #0, #0, #0, #0, { 20 - 27 } + #0, #0, #0, #0, #0, #0, #0, #0, { 28 - 2f } + #0, #0, #0, #0, #0, #0, #0, #0, { 30 - 37 } + #0, #0, #0, #0, #0, #0, #0, #0, { 38 - 3f } + #0, #0, #0, #0, #0, #0, #0, #0, { 40 - 47 } + #0, #0, '-', #0, #0, #0, '+', #0, { 48 - 4f } + #0, #0, #0, #0, #0, #0, #0, #0, { 50 - 57 } + #0, #0, #0, #0, #0, #0, #0, #0, { 58 - 5f } + #0, #0, #0, #0, #0, #0, #0, #0, { 60 - 67 } + #0, #0, #0, #0, #0, #0, #0, #0, { 68 - 6f } + #0, #0, #0, #0, #0, #0, #0, #0, { 70 - 77 } + #0, #0, #0, #0, #0, #0, #0, #0 { 78 - 7f } + ); + + LookupKeyToCharNumpadNumlock : array[0..127] of char = ( + #0, #0, #0, #0, #0, #0, #0, #0, { 00 - 07 } + #0, #0, #0, #0, #0, #0, #0, #0, { 08 - 0f } + #0, #0, #0, #0, #0, #0, #0, #0, { 10 - 17 } + #0, #0, #0, #0, #0, #0, #0, #0, { 18 - 1f } + #0, #0, #0, #0, #0, #0, #0, #0, { 20 - 27 } + #0, #0, #0, #0, #0, #0, #0, #0, { 28 - 2f } + #0, #0, #0, #0, #0, #0, #0, #0, { 30 - 37 } + #0, #0, #0, #0, #0, #0, #0, #0, { 38 - 3f } + #0, #0, #0, #0, #0, #0, #0, '7', { 40 - 47 } + '8', '9', '-', '4', '5', '6', '+', '1', { 48 - 4f } + '2', '3', '0', '.', #0, #0, #0, #0, { 50 - 57 } + #0, #0, #0, #0, #0, #0, #0, #0, { 58 - 5f } + #0, #0, #0, #0, #0, #0, #0, #0, { 60 - 67 } + #0, #0, #0, #0, #0, #0, #0, #0, { 68 - 6f } + #0, #0, #0, #0, #0, #0, #0, #0, { 70 - 77 } + #0, #0, #0, #0, #0, #0, #0, #0 { 78 - 7f } + ); + + LookupKeyToCharExtended : array[0..127] of char = ( + #0, #0, #0, #0, #0, #0, #0, #0, { 00 - 07 } + #0, #0, #0, #0, #0, #0, #0, #0, { 08 - 0f } + #0, #0, #0, #0, #0, #0, #0, #0, { 10 - 17 } + #0, #0, #0, #0, #0, #0, #0, #0, { 18 - 1f } + #0, #0, #0, #0, #0, #0, #0, #0, { 20 - 27 } + #0, #0, #0, #0, #0, #0, #0, #0, { 28 - 2f } + #0, #0, #0, #0, #0, '/', #0, #0, { 30 - 37 } + #0, #0, #0, #0, #0, #0, #0, #0, { 38 - 3f } + #0, #0, #0, #0, #0, #0, #0, #0, { 40 - 47 } + #0, #0, #0, #0, #0, #0, #0, #0, { 48 - 4f } + #0, #0, #0, #0, #0, #0, #0, #0, { 50 - 57 } + #0, #0, #0, #0, #0, #0, #0, #0, { 58 - 5f } + #0, #0, #0, #0, #0, #0, #0, #0, { 60 - 67 } + #0, #0, #0, #0, #0, #0, #0, #0, { 68 - 6f } + #0, #0, #0, #0, #0, #0, #0, #0, { 70 - 77 } + #0, #0, #0, #0, #0, #0, #0, #0 { 78 - 7f } + ); + +function KeyToChar(k: Key; modifiers: word) : char; +{ returns the equivalent character for the given key scan code and keyboard + modifiers (num/caps/scroll lock, shift status, etc.) } +begin + if (modifiers and KB_MOD_EXTENDED) <> 0 then begin + KeyToChar := LookupKeyToCharExtended[k]; + + end else if (k >= $47) and (k <= $53) then begin + { handle numpad keys specially } + if (modifiers and KB_MOD_NUM_LOCK) <> 0 then begin + if (modifiers and KB_MOD_SHIFT) <> 0 then + KeyToChar := LookupKeyToCharNumpad[k] + else + KeyToChar := LookupKeyToCharNumpadNumLock[k]; + + end else begin + if (modifiers and KB_MOD_SHIFT) <> 0 then + KeyToChar := LookupKeyToCharNumpadNumLock[k] + else + KeyToChar := LookupKeyToCharNumpad[k]; + + end; + + end else begin + { everything else } + if (modifiers and KB_MOD_CAPS_LOCK) <> 0 then begin + if (modifiers and KB_MOD_SHIFT) <> 0 then + KeyToChar := LookupKeyToCharCapsShift[k] + else + KeyToChar := LookupKeyToCharCaps[k]; + + end else begin + if (modifiers and KB_MOD_SHIFT) <> 0 then + KeyToChar := LookupKeyToCharShift[k] + else + KeyToChar := LookupKeyToChar[k]; + + end; + end; +end; + +end. diff --git a/GDLIB/GDMOUSE.PAS b/GDLIB/GDMOUSE.PAS new file mode 100644 index 0000000..8336074 --- /dev/null +++ b/GDLIB/GDMOUSE.PAS @@ -0,0 +1,473 @@ +{ GDlib Mouse Handler + Gered King, 2018 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDMouse; + +interface + +type + MouseButton = byte; + + CursorBitmap = array[0..63] of byte; + PCursorBitmap = ^CursorBitmap; + +const + MOUSE_LEFT_BUTTON = $01; + MOUSE_RIGHT_BUTTON = $02; + MOUSE_MIDDLE_BUTTON = $04; + + CURSOR_WIDTH = 16; + CURSOR_HEIGHT = 16; + + MouseX : integer = 0; + MouseY : integer = 0; + MouseButtons : word = 0; + MouseDeltaX : integer = 0; + MouseDeltaY : integer = 0; + +function InitMouse : boolean; +function CloseMouse : boolean; +function IsMouseInitialized : boolean; +function IsMousePresent : boolean; +procedure ShowMouse; +procedure HideMouse; +procedure SetMouseBounds(minX, minY, maxX, maxY: integer); +procedure SetMouseCursor(const bitmap: PCursorBitmap; hotspotX, hotspotY: integer); +procedure DrawMouseCursor; + +implementation + +uses GDGfx, GDClip, GDEvents, Toolbox; + +const + MOUSE_FILL_COLOR = 15; + MOUSE_OUTLINE_COLOR = 0; + + _hasMouse : boolean = false; + _mouseInstalled : boolean = false; + _mouseVisible : boolean = false; + + _cursorHotspotX : integer = 0; + _cursorHotspotY : integer = 0; + + { copy of the default microsoft mouse driver's cursor in graphics modes } + _defaultCursorBitmap : CursorBitmap = ( + $ff,$3f,$ff,$1f,$ff,$0f,$ff,$07, + $ff,$03,$ff,$01,$ff,$00,$7f,$00, + $3f,$00,$1f,$00,$ff,$01,$ff,$00, + $ff,$30,$7f,$f8,$7f,$f8,$ff,$fc, + $00,$00,$00,$40,$00,$60,$00,$70, + $00,$78,$00,$7c,$00,$7e,$00,$7f, + $80,$7f,$00,$7c,$00,$6c,$00,$46, + $00,$06,$00,$03,$00,$03,$00,$00 + ); + +var + _currentCursorBitmap : CursorBitmap; + _mouseEvent : PInputEvent; + _mousePrevButtons : word; + +procedure ResetMouseState; +begin + MouseX := 0; + MouseY := 0; + MouseButtons := 0; + _mousePrevButtons := 0; + MouseDeltaX := 0; + MouseDeltaY := 0; +end; + +function InitMouseDriver : boolean; +begin + asm + mov ax, 0 + int 33h + mov @Result, al { ax = 0 if it failed } + end; + + { reset our copy of the current mouse cursor bitmap at the same time } + MemCopy(@_currentCursorBitmap, @_defaultCursorBitmap, SizeOf(CursorBitmap)); + _cursorHotspotX := 0; + _cursorHotspotY := 0; +end; + +procedure UpdateMouseState; +assembler; +asm + mov ax, 3 + int 33h + shr cx, 1 + mov MouseX, cx { MouseX = cx / 2 } + mov MouseY, dx + mov ax, MouseButtons + mov _mousePrevButtons, ax { MousePrevButtons = MouseButtons } + mov MouseButtons, bx + mov MouseDeltaX, 0 + mov MouseDeltaY, 0 +end; + +procedure PushMotionEvent; +begin + _mouseEvent := PushEvent; + + with _mouseEvent^ do begin + Event := EVENT_TYPE_MOUSE_MOTION; + MM_X := MouseX; + MM_Y := MouseY; + MM_DeltaX := MouseDeltaX; + MM_DeltaY := MouseDeltaY; + MM_Buttons := MouseButtons; + end; +end; + +procedure PushButtonEvent(action: EventAction; button: MouseButton); +begin + _mouseEvent := PushEvent; + + with _mouseEvent^ do begin + Event := EVENT_TYPE_MOUSE_BUTTON; + MB_X := MouseX; + MB_Y := MouseY; + MB_Action := action; + MB_Button := button; + end; +end; + +procedure ProcessMouseEvents; +begin + if not IsEventsInitialized then + exit; + + if (MouseDeltaX <> 0) or (MouseDeltaY <> 0) then + PushMotionEvent; + + if MouseButtons <> _mousePrevButtons then begin + if (MouseButtons and MOUSE_LEFT_BUTTON) <> + (_mousePrevButtons and MOUSE_LEFT_BUTTON) then begin + if (MouseButtons and MOUSE_LEFT_BUTTON) > 0 then + PushButtonEvent(EVENT_ACTION_PRESSED, MOUSE_LEFT_BUTTON) + else + PushButtonEvent(EVENT_ACTION_RELEASED, MOUSE_LEFT_BUTTON); + end; + + if (MouseButtons and MOUSE_RIGHT_BUTTON) <> + (_mousePrevButtons and MOUSE_RIGHT_BUTTON) then begin + if (MouseButtons and MOUSE_RIGHT_BUTTON) > 0 then + PushButtonEvent(EVENT_ACTION_PRESSED, MOUSE_RIGHT_BUTTON) + else + PushButtonEvent(EVENT_ACTION_RELEASED, MOUSE_RIGHT_BUTTON); + end; + + if (MouseButtons and MOUSE_MIDDLE_BUTTON) <> + (_mousePrevButtons and MOUSE_MIDDLE_BUTTON) then begin + if (MouseButtons and MOUSE_MIDDLE_BUTTON) > 0 then + PushButtonEvent(EVENT_ACTION_PRESSED, MOUSE_MIDDLE_BUTTON) + else + PushButtonEvent(EVENT_ACTION_RELEASED, MOUSE_MIDDLE_BUTTON); + end; + end; +end; + +procedure MouseHandler; +{ our custom mouse handler. + this is written as an 'assembler' proc because the mouse driver passes it + the mouse status via registers. using a pascal 'interrupt' proc would + kind of work also, except that we would have to do a hacky return to ensure + the registers are popped correctly and that a 'retf' is used for the + return (instead of an 'iret' which is what pascal would otherwise do). + doing this with an 'assembler' proc instead just seemed cleaner to me... } +far; +assembler; +asm + { inputs provided by mouse driver: + AX = event trigger bit + BX = button state + CX = X coordinate + DX = Y coordinate + DI = horizontal mickeys + SI = vertical mickeys } + + pusha + + mov ax, seg @Data { restore DS so that we can access pascal vars } + mov ds, ax + + shr cx, 1 { mouse x coordinate is doubled for some reason } + + mov ax, MouseButtons + mov _mousePrevButtons, ax { MousePrevButtons := MouseButtons } + mov MouseButtons, bx + + mov ax, cx + sub ax, MouseX + mov MouseDeltaX, ax { MouseDeltaX := CX - MouseX } + + mov ax, dx + sub ax, MouseY + mov MouseDeltaY, ax { MouseDeltaY := DX - MouseX } + + mov MouseX, cx + mov MouseY, dx + + call ProcessMouseEvents + + popa +end; + +function InitMouse : boolean; +{ initializes the mouse driver (if there is one present) and then installs + our custom mouse event handler. returns true if the mouse was set up + successfully or if there is no mouse device connected (check + IsMousePresent() to be sure). returns false if an error occured setting + up the mouse or if it was already initialized. } +begin + if _mouseInstalled then begin + InitMouse := false; + exit; + end; + + ResetMouseState; + _hasMouse := InitMouseDriver; + if not _hasMouse then begin + _mouseInstalled := true; + InitMouse := true; + exit; + end; + + UpdateMouseState; + + asm + mov ax, 0ch + mov cx, 31 + mov dx, seg MouseHandler + mov es, dx + mov dx, offset MouseHandler + int 33h + end; + + _mouseVisible := false; + _mouseInstalled := true; + InitMouse := true; +end; + +function CloseMouse : boolean; +{ removes a previously installed custom mouse event handler and resets the + mouse driver to it's initial state. } +begin + if not _mouseInstalled then begin + CloseMouse := true; + exit; + end; + + if not _hasMouse then begin + _mouseInstalled := false; + CloseMouse := true; + exit; + end; + + asm + mov ax, 0ch + mov cx, 0 + int 33h + end; + + ResetMouseState; + InitMouseDriver; + + _mouseVisible := false; + _mouseInstalled := false; + CloseMouse := true; +end; + +function IsMouseInitialized : boolean; +{ returns true if the mouse driver was initialized successfully } +begin + IsMouseInitialized := _mouseInstalled; +end; + +function IsMousePresent : boolean; +{ returns true if a mouse device is currently connected to the computer } +begin + IsMousePresent := _hasMouse; +end; + +procedure ShowMouse; +{ shows the mouse cursor. if the mouse cursor is currently shown, this does + nothing } +begin + if not _hasMouse then + exit; + if _mouseVisible then + exit; + + asm + mov ax, 1 + int 33h + end; + _mouseVisible := true; +end; + +procedure HideMouse; +{ hides the mouse cursor. if the mouse cursor is not currently shown, this + does nothing } +begin + if not _hasMouse then + exit; + if not _mouseVisible then + exit; + + asm + mov ax, 2 + int 33h; + end; + _mouseVisible := false; +end; + +procedure SetMouseBounds(minX, minY, maxX, maxY: integer); +{ sets the pixel boundaries for the mouse cursor } +begin + if not _hasMouse then + exit; + + asm + mov ax, 7 + mov cx, minX + mov dx, maxX + int 33h + + mov ax, 8 + mov cx, minY + mov dx, maxY + int 33h + end; +end; + +procedure SetMouseCursor(const bitmap: PCursorBitmap; + hotspotX, hotspotY: integer); +{ changes the mouse cursor to the specified bitmap. if the bitmap is nil, + resets the cursor back to the original bitmap } +begin + { make a copy of the bitmap, solely for DrawMouseCursor to use it. + (there is no mouse driver function for reading the current cursor + bitmap?) } + if bitmap = nil then + MemCopy(@_currentCursorBitmap, @_defaultCursorBitmap, SizeOf(CursorBitmap)) + else + MemCopy(@_currentCursorBitmap, bitmap, SizeOf(CursorBitmap)); + + _cursorHotspotX := hotspotX; + _cursorHotspotY := hotspotY; + + asm + mov ax, 9h + mov bx, hotspotX + mov cx, hotspotY + mov dx, seg _currentCursorBitmap + mov es, dx + mov dx, offset _currentCursorBitmap + int 33h + end; +end; + +procedure LLBlitMouseCursor(width, height, destYinc, leftClipBits: integer; + destOffs, srcSeg, srcOffs: word); +assembler; +asm + push ds + + mov dx, height { dx = line loop counter } + test dx, dx { stop now if there's zero lines to draw } + jz @done + + call far ptr GetBoundLayerSegment + mov es, ax + mov di, destOffs + mov ds, srcSeg + mov si, srcOffs + +@draw_line: + mov ax, ds:[si] { load next screen mask word } + mov bx, ds:[si+32] { load next shape mask word } + mov cx, leftClipBits + test cx, cx + jz @done_bits_clipping { trim off left bits (for clipping) if needed } + shl ax, cl + shl bx, cl +@done_bits_clipping: + mov cx, width { cx = number of pixels to draw } + { ax = screen mask word } + { bx = shape mask word } + +@draw_pixel: + shl ax, 1 + jc @skip_pixel { screen mask bit is 1? skip this pixel } + shl bx, 1 + jnc @draw_cursor_outline_px +@draw_cursor_color_px: { draw inner color if shape bit is 1 } + mov es:[di], byte(MOUSE_FILL_COLOR) + jmp @end_pixel +@draw_cursor_outline_px: { or, draw outline color if shape bit is 0 } + mov es:[di], byte(MOUSE_OUTLINE_COLOR) + jmp @end_pixel + +@skip_pixel: + shl bx, 1 { skipping this pixel, need to also shift the } + { shape mask word to keep them both at the } + { same location } + +@end_pixel: + inc di { move to the next pixel } + dec cx { decrease pixel drawing counter } + jnz @draw_pixel + +@end_line: + add si, 2 { move to next line } + add di, destYinc + dec dx { decrease line loop counter } + jnz @draw_line + +@done: + pop ds +end; + +procedure DrawMouseCursor; +{ draws the mouse cursor at it's current location. this draws it completely + independently from the mouse driver. it should only be used after a call + to HideMouse and when your application is redrawing the entire screen + every frame. otherwise, the built-in mouse driver cursor rendering is + probably the best choice. } +var + x, y: integer; + srcX, srcY, srcWidth, srcHeight: integer; + srcOffs, destOffs: word; + destYinc: integer; +begin + if not _mouseInstalled then + exit; + + { destination always at current mouse cursor position (adjusted by + hotspot X/Y, which is how the normal mouse driver does it) } + x := MouseX - _cursorHotspotX; + y := MouseY - _cursorHotspotY; + + srcX := 0; + srcY := 0; + srcWidth := CURSOR_WIDTH; + srcHeight := CURSOR_HEIGHT; + + if not ClipBlitToScreen(srcX, srcY, srcWidth, srcHeight, x, y) then + exit; + + srcOffs := Ofs(_currentCursorBitmap[srcY * 2]); + destOffs := GetBoundLayerOffsetAt(x, y); + destYinc := SCREEN_WIDTH - srcWidth; + + LLBlitMouseCursor(srcWidth, srcHeight, + destYinc, srcX, + destOffs, + Seg(_currentCursorBitmap), srcOffs); +end; + +end. diff --git a/GDLIB/GDPCX.PAS b/GDLIB/GDPCX.PAS new file mode 100644 index 0000000..3db445e --- /dev/null +++ b/GDLIB/GDPCX.PAS @@ -0,0 +1,356 @@ +{ GDlib PCX file load/save support + Gered King, 2018 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDPCX; + +interface + +uses GDGfx; + +type + PCXResult = (PCXNotFound, PCXIOError, PCXBadFile, PCXOk); + +function LoadPCXTo(const filename: string; pal: PPalette; dest: pointer; bytesPerLine: word) : PCXResult; +function LoadPCXToBitmap(const filename: string; pal: PPalette; bmp: PBitmap) : PCXResult; +function LoadPCX(const filename: string; pal: PPalette) : PCXResult; +function SavePCXFrom(const filename: string; pal: PPalette; src: pointer; srcWidth, srcHeight: word) : PCXResult; +function SavePCXFromBitmap(const filename: string; pal: PPalette; const bmp: PBitmap) : PCXResult; +function SavePCX(const filename: string; pal: PPalette) : PCXResult; + +implementation + +uses Toolbox; + +type + PCXHeader = record + Manufacturer : byte; + Version : byte; + Encoding : byte; + Bpp : byte; + X, Y : word; + Width, Height : word; + HorizontalDpi : word; + VerticalDpi : word; + EgaPalette : array[0..47] of byte; + Reserved : byte; + NumColorPlanes : byte; + BytesPerLine : word; + PaletteType : word; + HorizontalSize : word; + VerticalSize : word; + Padding : array[0..53] of byte; + end; + +function LoadPCXTo(const filename: string; + pal: PPalette; + dest: pointer; + bytesPerLine: word) : PCXResult; +{ loads a PCX file, storing the loaded pixel data at the pointer given. if + a palette is provided, the palette data from the PCX file will also be + loaded. returns PCXOk if successful. } +var + p : ^byte; + linePtrInc : word; + f : file; + header : PCXHeader; + i, count, x, y : integer; + pcxWidth : integer; + pcxHeight : integer; + data : byte; +label ioError; +begin + Assign(f, filename); + + Reset(f, 1); + if IOResult <> 0 then begin + Close(f); + x := IOResult; { clear i/o error flag } + LoadPCXTo := PCXNotFound; + exit; + end; + + { read PCX header } + BlockRead(f, header, SizeOf(PCXHeader)); + if IOResult <> 0 then goto ioError; + + { validate header. we only support about 256 color PCX files } + if (header.Manufacturer <> 10) + or (header.Version <> 5) + or (header.Encoding <> 1) + or (header.Bpp <> 8) then begin + Close(f); + LoadPCXTo := PCXBadFile; + exit; + end; + + pcxWidth := header.Width; + pcxHeight := header.Height; + p := dest; + linePtrInc := (bytesPerLine - pcxWidth - 1); + + for y := 0 to pcxHeight do begin + { write pixels out per-scanline } + x := 0; + while x < header.BytesPerLine do begin + { read pixel (or RLE count ...) } + BlockRead(f, data, 1); + if IOResult <> 0 then goto ioError; + + if (data and $c0) = $c0 then begin + { it was an RLE count, actual pixel is the next byte ... } + count := data and $3f; + BlockRead(f, data, 1); + if IOResult <> 0 then goto ioError; + end else begin + count := 1; + end; + + { store this pixel color the specified number of times } + while count > 0 do begin + if x <= pcxWidth then + p^ := data; + + inc(p); + inc(x); + dec(count); + end; + end; + + inc(p, linePtrInc); + end; + + { read palette, if needed } + if pal <> nil then begin + Seek(f, FileSize(f) - 768); + + BlockRead(f, pal^, SizeOf(Palette)); + if IOResult <> 0 then goto ioError; + + { convert PCX palette format to VGA RGB format } + for i := 0 to 255 do begin + pal^[i, 0] := pal^[i, 0] shr 2; + pal^[i, 1] := pal^[i, 1] shr 2; + pal^[i, 2] := pal^[i, 2] shr 2; + end; + end; + + Close(f); + x := IOResult; { clear i/o error flag (just in case) } + LoadPCXTo := PCXOk; + exit; + +ioError: + Close(f); + x := IOResult; { clear i/o error flag } + LoadPCXTo := PCXIOError; +end; + +function LoadPCXToBitmap(const filename: string; + pal: PPalette; + bmp: PBitmap) : PCXResult; +{ loads a PCX file onto the given bitmap. the destination bitmap should be + pre-allocated to a size sufficient to hold the PCX file being loaded. if a + palette is provided, the palette data from the PCX file will also be + loaded. returns PCXOk if successful. } +var + dest : pointer; +begin + dest := @bmp^.Pixels; + LoadPCXToBitmap := LoadPCXTo(filename, pal, dest, bmp^.Width); +end; + +function LoadPCX(const filename: string; + pal: PPalette) : PCXResult; +{ loads a PCX file onto the currently bound layer. the PCX file being loaded + should not contain an image larger then 320x200. if a palette is provided, + the palette data from the PCX file will also be loaded. returns PCXOk if + successful. } +var + dest : pointer; +begin + dest := ptr(GetBoundLayerSegment, GetBoundLayerOffset); + LoadPCX := LoadPCXTo(filename, pal, dest, SCREEN_WIDTH); +end; + +function WritePCXData(var f: file; + const runCount: integer; + pixel: byte) : boolean; +var + data : byte; +begin + WritePCXData := true; + + if (runCount > 1) or ((pixel and $c0) = $c0) then begin + data := $c0 or runCount; + BlockWrite(f, data, 1); + if IOResult <> 0 then begin + WritePCXData := false; + exit; + end; + end; + + BlockWrite(f, pixel, 1); + if IOResult <> 0 then begin + WritePCXData := false; + exit; + end; +end; + +function SavePCXFrom(const filename: string; + pal: PPalette; + src: pointer; + srcWidth, srcHeight: word) : PCXResult; +{ saves the pixel data located at the given pointer (with the given + dimensions) to a PCX file. if a palette is provided, that palette is saved + to the file, otherwise the current VGA palette is saved instead. returns + PCXOk if successful. } +var + p : ^byte; + linePtrInc : word; + f : file; + x, y, runCount, i : integer; + pixel, runPixel : byte; + rgb : array[0..2] of byte; + header : PCXHeader; + srcRight : word; + srcBottom : word; +label ioError; +begin + Assign(f, filename); + + Rewrite(f, 1); + if IOResult <> 0 then goto ioError; + + srcRight := srcWidth - 1; + srcBottom := srcHeight - 1; + + MemFill(@header, 0, SizeOf(PCXHeader)); + header.Manufacturer := 10; + header.Version := 5; + header.Encoding := 1; + header.Bpp := 8; + header.X := 0; + header.Y := 0; + header.Width := srcRight; + header.Height := srcBottom; + header.HorizontalDpi := 0; + header.VerticalDpi := 0; + header.NumColorPlanes := 1; + header.BytesPerLine := srcWidth; + header.PaletteType := 1; + header.HorizontalSize := 320; + header.VerticalSize := 200; + + BlockWrite(f, header, SizeOf(PCXHeader)); + if IOResult <> 0 then goto ioError; + + { write image data } + p := src; + i := 0; + + for y := 0 to srcBottom do begin + { write one scanline at a time. breaking runs that could have continued + across scanlines in the process, as per the pcx standard } + runCount := 0; + runPixel := 0; + for x := 0 to srcRight do begin + pixel := p^; + inc(p); + + if runCount = 0 then begin + runCount := 1; + runPixel := pixel; + + end else begin + if (pixel <> runPixel) or (runCount >= 63) then begin + if (not WritePCXData(f, runCount, runPixel)) then goto ioError; + + runCount := 1; + runPixel := pixel; + + end else begin + inc(runCount); + end; + end; + end; + + { end the scanline, writing out whatever run we might have had going } + if (not WritePCXData(f, runCount, runPixel)) then + goto ioError; + end; + + pixel := 12; + BlockWrite(f, pixel, 1); + if IOResult <> 0 then goto ioError; + + { write out provided palette, or the current VGA palette } + if pal <> nil then begin + for i := 0 to 255 do begin + rgb[0] := pal^[i, 0] shl 2; + rgb[1] := pal^[i, 1] shl 2; + rgb[2] := pal^[i, 2] shl 2; + BlockWrite(f, rgb, 3); + if IOResult <> 0 then goto ioError; + end; + + end else begin + for i := 0 to 255 do begin + GetColor(i, rgb[0], rgb[1], rgb[2]); + + rgb[0] := rgb[0] shl 2; + rgb[1] := rgb[1] shl 2; + rgb[2] := rgb[2] shl 2; + + BlockWrite(f, rgb, 3); + if IOResult <> 0 then goto ioError; + end; + + end; + + Close(f); + x := IOResult; { clear i/o error flag (just in case) } + SavePCXFrom := PCXOk; + exit; + +ioError: + Close(f); + x := IOResult; { clear i/o error flag } + SavePCXFrom := PCXIOError; +end; + +function SavePCXFromBitmap(const filename: string; + pal: PPalette; + const bmp: PBitmap) : PCXResult; +{ saves the specified bitmap to a PCX file. if a palette is provided, that + palette is saved to the file, otherwise the current VGA palette is saved + instead. returns PCXOk if successful. } +var + src : pointer; +begin + src := @bmp^.Pixels; + SavePCXFromBitmap := SavePCXFrom(filename, + pal, + src, + bmp^.Width, + bmp^.Height); +end; + +function SavePCX(const filename: string; + pal: PPalette) : PCXResult; +{ saves the currently bound layer to a PCX file. if a palette is provided, + that palette is saved to the file, otherwise the current VGA palette is + saved instead. returns PCXOk if successful. } +var + src : pointer; +begin + src := ptr(GetBoundLayerSegment, GetBoundLayerOffset); + SavePCX := SavePCXFrom(filename, + pal, + src, + SCREEN_WIDTH, + SCREEN_HEIGHT); +end; + +end. diff --git a/GDLIB/GDTIMER.PAS b/GDLIB/GDTIMER.PAS new file mode 100644 index 0000000..0032767 --- /dev/null +++ b/GDLIB/GDTIMER.PAS @@ -0,0 +1,198 @@ +{ GDlib Higher Frequency Timer Utilities + Gered King, 2021 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit GDTimer; + +interface + +const + + { count of the number of times the timer interrupt has been raised. + this will be incremented 'freq' times per second once InitTimer + has been called. } + TimerTicks : longint = 0; + +function InitTimer(freq: word) : boolean; +function CloseTimer : boolean; +function GetTimerFrequency : word; +function MarkTimer : longint; +procedure WaitForTime(delay : word); + +implementation + +uses Dos; + +const + PIC_CTRL_PORT = $20; + CHANNEL_0_PORT = $40; + COMMAND_PORT = $43; + + TIMER_FREQ_SET_COMMAND = $36; { mode 2 (rate generator), + read/write lo-byte of counter, + read/write hi-byte of counter } + + TIMER_CLOCK_RATE = 1193180; { 1.19318 mhz } + ORIGINAL_TIMER_FREQ = 18.2065; + + _timerInstalled : boolean = false; + _timerFreq : word = 0; + _lastMarkedAt : longint = 0; + +var + _oldTimerCounter : longint; + _oldTimerTriggerAt : longint; + _oldTimerInterrupt : pointer; + +procedure SetTimerFrequency(freq: word); +{ configures the PC 8253 timer to trigger interrupt 8 at the given frequency. + the value provided here should simply be just that: the number of times + per second that interrupt 8 should be triggered per second. } +var + counter0 : word; +begin + if freq = 0 then + counter0 := 0 + else + counter0 := TIMER_CLOCK_RATE div freq; + + { calculate the number of timer interrupt ticks that will need to elapse + (at our new timer frequency) before our custom interrupt should call the + original timer interrupt handler to ensure it is still called at the + original 18.2hz frequency } + _oldTimerTriggerAt := round(freq / ORIGINAL_TIMER_FREQ); + + port[COMMAND_PORT] := TIMER_FREQ_SET_COMMAND; + port[CHANNEL_0_PORT] := Lo(counter0); + port[CHANNEL_0_PORT] := Hi(counter0); + + _timerFreq := freq; +end; + +procedure TimerHandler; +{ custom timer (interrupt 8) handler. + this has been written as a 'raw' assembler procedure instead of using + a more typical pascal 'interrupt' procedure just to keep this as lean + as possible since it will potentially be called hundreds (or more) + times per second } +far; +assembler; +asm + push ds + db $66; push ax + + mov ax, seg @Data { restore DS so that we can access pascal vars } + mov ds, ax + + db $66; inc word ptr [TimerTicks] + + { house-keeping to ensure the original interrupt 8 handler is still + called at the rate it should be (18.2hz) } + + db $66; inc word ptr [_oldTimerCounter] + + { if _oldTimerCounter < _oldTimerTriggerAt, then skip calling the + original interrupt 8 handler } + db $66; mov ax, word(_oldTimerCounter) + db $66; cmp ax, word(_oldTimerTriggerAt) + jl @done + + { otherwise (if _oldTimerCounter >= _oldTimerTriggerAt), then, + reset the counter back to zero and call the original interrupt 8 + handler } + db $66; xor ax, ax + db $66; mov word(_oldTimerCounter), ax + pushf + call [_oldTimerInterrupt] + +@done: + { tell the PIC that we're done } + mov al, $20 + out PIC_CTRL_PORT, al + + db $66; pop ax + pop ds + iret +end; + +function InitTimer(freq: word) : boolean; +{ installs a custom timer interrupt handler (interrupt 8). returns false if + the timer interrupt handler could not be installed for some reason, or if + the custom handler was already installed. } +begin + InitTimer := false; + if _timerInstalled then exit; + + TimerTicks := 0; + _oldTimerCounter := 0; + _lastMarkedAt := 0; + + asm cli end; + SetTimerFrequency(freq); + GetIntVec(8, _oldTimerInterrupt); + SetIntVec(8, @TimerHandler); + asm sti end; + + _timerInstalled := true; + InitTimer := true; +end; + +function CloseTimer : boolean; +{ removes a previously installed custom timer interrupt handler. } +begin + CloseTimer := false; + if not _timerInstalled then exit; + + asm cli end; + SetTimerFrequency(0); { resets back to the normal 18.2hz } + SetIntVec(8, _oldTimerInterrupt); + asm sti end; + + TimerTicks := 0; + _oldTimerCounter := 0; + _oldTimerInterrupt := nil; + + _timerInstalled := false; + CloseTimer := true; +end; + +function GetTimerFrequency : word; +{ returns the frequency that the installed custom timer interrupt handler + is being triggered at. if no custom timer interrupt handler is installed, + returns 0 } +begin + GetTimerFrequency := _timerFreq; +end; + +function MarkTimer : longint; +{ used to calculate time differences between subsequent calls to this + function. the very first time it is called, the return value should + probably be ignored (will be the ticks since the timer subsystem was + initialized). } +var + newMarkedAt : longint; +begin + newMarkedAt := TimerTicks; + MarkTimer := newMarkedAt - _lastMarkedAt; + _lastMarkedAt := newMarkedAt; +end; + +procedure WaitForTime(delay : word); +{ waits indefinitely for specified number of ticks to elapse } +var + startedAt : longint; +begin + if not _timerInstalled then exit; + + startedAt := TimerTicks; + while (TimerTicks - startedAt) < delay do begin + end; +end; + +begin + if Test8086 < 2 then begin + writeln('The GDTIMER unit requires a 386 cpu or higher!'); + halt; + end; +end. diff --git a/GDLIB/MATH.PAS b/GDLIB/MATH.PAS new file mode 100644 index 0000000..d55becf --- /dev/null +++ b/GDLIB/MATH.PAS @@ -0,0 +1,543 @@ +{ Math helper functions and lookup tables. + Gered King, 2019 } + +{ You MUST manually call 'InitTrigTables' in your programs before using + any of these functions that use trig!! } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Math; + +interface + +const + PI = 3.141592654; + PI_OVER_180 = PI / 180.0; + + DEG_TO_RAD = PI_OVER_180; + RAD_TO_DEG = 1.0 / PI_OVER_180; + + DEG_TO_BIN = 1024 / 360; + BIN_TO_DEG = 1.0 / (DEG_TO_BIN); + RAD_TO_BIN = 512 / PI; + BIN_TO_RAD = 1.0 / (RAD_TO_BIN); + + { note: might want to define these manually ... ? + trunc vs round makes this fun if you ever change the binangle range.. } + BIN_ANGLE_1 = round(1 * DEG_TO_BIN); + BIN_ANGLE_45 = round(45 * DEG_TO_BIN); + BIN_ANGLE_90 = round(90 * DEG_TO_BIN); + BIN_ANGLE_135 = round(135 * DEG_TO_BIN); + BIN_ANGLE_180 = round(180 * DEG_TO_BIN); + BIN_ANGLE_225 = round(225 * DEG_TO_BIN); + BIN_ANGLE_270 = round(270 * DEG_TO_BIN); + BIN_ANGLE_315 = round(315 * DEG_TO_BIN); + BIN_ANGLE_359 = round(359 * DEG_TO_BIN); + BIN_ANGLE_360 = round(360 * DEG_TO_BIN); + + BIN_ANGLE_TAN_MASK = BIN_ANGLE_180-1; + BIN_ANGLE_MASK = BIN_ANGLE_360-1; + + M33_11 = 0; + M33_12 = 3; + M33_13 = 6; + M33_21 = 1; + M33_22 = 4; + M33_23 = 7; + M33_31 = 2; + M33_32 = 5; + M33_33 = 8; + +type + BinAngle = integer; { binary angles, where 0-1023 = full circle } + + Vec2 = record + X, Y : single; + end; + PVec2 = ^Vec2; + + Mtx33 = record + m : array[0..8] of single; + end; + PMtx33 = ^Mtx33; + +const + ZERO_VEC2 : Vec2 = (X: 0.0; Y: 0.0); + IDENTITY_MTX33 : Mtx33 = (m: (1.0, 0.0, 0.0, + 0.0, 1.0, 0.0, + 0.0, 0.0, 1.0)); + +var + SinTable : array[0..1023] of single; + CosTable : array[0..1023] of single; + TanTable : array[0..511] of single; + +procedure InitTrigTables; + +function Lerp(a, b, t: single) : single; +function InvLerp(a, b, lerped: single) : single; +function Atan(x : single) : binangle; +function Atan2(y, x : single) : binangle; +function AngleBetween(x1, y1, x2, y2: single) : binangle; +procedure AngleToDir2D(angle: binangle; var outX, outY: single); +procedure AngleToVec2D(angle: binangle; var out: Vec2); + +procedure Vec2_Set(var out : Vec2; x, y : single); +procedure Vec2_Zero(var out : Vec2); +procedure Vec2_Add(var out : Vec2; const a, b : Vec2); +procedure Vec2_AddTo(var out : Vec2; const v : Vec2); +procedure Vec2_Sub(var out : Vec2; const a, b : Vec2); +procedure Vec2_SubFrom(var out : Vec2; const v : Vec2); +procedure Vec2_Scale(var out : Vec2; const a : Vec2; n : single); +function Vec2_Distance(const a, b : Vec2) : single; +function Vec2_DistanceSqr(const a, b : Vec2) : single; +function Vec2_Dot(const a, b : Vec2) : single; +function Vec2_Length(const a : Vec2) : single; +function Vec2_LengthSqr(const a : Vec2) : single; +procedure Vec2_Normalize(var out : Vec2; const a : Vec2); +procedure Vec2_NormalizeThis(var out : Vec2); +procedure Vec2_SetLength(var out : Vec2; const a : Vec2; length : single); +procedure Vec2_SetThisLength(var out : Vec2; length : single); +procedure Vec2_Lerp(var out : Vec2; const a, b : Vec2; t : single); + +procedure Mtx33_Identity(var out : Mtx33); +procedure Mtx33_RotationX(var out : Mtx33; angle : binangle); +procedure Mtx33_RotationY(var out : Mtx33; angle : binangle); +procedure Mtx33_RotationZ(var out : Mtx33; angle : binangle); +procedure Mtx33_Mul(var out, a, b : Mtx33); +procedure Mtx33_Transform2D(var out : Vec2; var m : Mtx33; var v : Vec2); +procedure Mtx33_Translation2D(var out : Mtx33; x, y : single); +procedure Mtx33_Scaling2D(var out : Mtx33; x, y : single); +procedure Mtx33_Rotation2D(var out : Mtx33; angle : binangle); + +implementation + +function Fequ(a, b: single) : boolean; +begin + { TODO: lol, this is maybe somewhat 'ok', but rewrite this garbage } + Fequ := (abs(a - b) <= 0.00005); +end; + +procedure InitTrigTables; +{ populates the trig lookup tables with sin/cos/tan values for the entire + range of binary angles supported (0 to BIN_ANGLE_MASK). } +var + angle : binangle; + r, s, c : single; +begin + for angle := 0 to BIN_ANGLE_MASK do begin + r := angle * BIN_TO_RAD; + s := sin(r); + c := cos(r); + + SinTable[angle] := s; + CosTable[angle] := c; + if angle <= BIN_ANGLE_TAN_MASK then begin + if (angle = BIN_ANGLE_90) or (angle = BIN_ANGLE_270) then + TanTable[angle] := 0 + else + TanTable[angle] := (s / c); + end; + end; +end; + +function Lerp(a, b, t: single) : single; +{ returns the interpolated value between the ranged defined by a and b. } +begin + Lerp := a + (b - a) * t; +end; + +function InvLerp(a, b, lerped: single) : single; +{ returns the 't' value used in a call to Lerp that returned the given + 'lerped' value using the range a to b (approximately, anyway). } +begin + InvLerp := (lerped - a) / (b - a); +end; + +function Atan(x : single) : binangle; +{ calculates the arctangent of X. returns the result as a binary angle. + functionally equivalent to ArcTan(). } +var + a, b, c : integer; + d : single; +begin + if x >= 0 then begin + a := 0; + b := (BIN_ANGLE_90 - 1); + end else begin + a := BIN_ANGLE_90; + b := (BIN_ANGLE_180 - 1); + end; + + repeat + c := (a + b) div 2; + d := x - TanTable[c]; + + if d > 0.0 then + a := c + 1 + else if d < 0.0 then + b := c - 1; + until ((a > b) or (d = 0.0)); + + if x >= 0 then + Atan := c + else + Atan := -BIN_ANGLE_180 + c; +end; + +function Atan2(y, x : single) : binangle; +{ calculates the arctangent of Y/X. returns the result as a binary angle. + functionally equivalent to atan2() from the C runtime library. } +var + r : single; + b : binangle; +begin + if x = 0.0 then begin + if y = 0.0 then begin + Atan2 := 0; + end else begin + if y < 0.0 then + Atan2 := -BIN_ANGLE_90 + else + Atan2 := BIN_ANGLE_90; + end; + exit; + end; + + r := y / x; + b := Atan(r); + + if x >= 0.0 then + Atan2 := b + else if y >= 0.0 then + Atan2 := BIN_ANGLE_180 + b + else + Atan2 := b - BIN_ANGLE_180; +end; + +function AngleBetween(x1, y1, x2, y2: single) : binangle; +{ calculates the binary angle between the two points } +var + deltaX, deltaY : single; +begin + deltaX := x2 - x1; + deltaY := y2 - y1; + if (Fequ(deltaX, 0.0) and Fequ(deltaY, 0.0)) then + AngleBetween := 0 + else + AngleBetween := Atan2(deltaY, deltaX); +end; + +procedure AngleToDir2D(angle: binangle; + var outX, outY: single); +{ for a given binary angle, calculates a normalized 2D direction vector + that points in the same direction as the angle } +begin + outX := CosTable[angle and BIN_ANGLE_MASK]; + outY := SinTable[angle and BIN_ANGLE_MASK]; +end; + +procedure AngleToVec2D(angle: binangle; + var out: Vec2); +{ for a given binary angle, calculates a normalized Vec2 that points in the + same direction as the angle } +begin + with out do begin + X := CosTable[angle and BIN_ANGLE_MASK]; + Y := SinTable[angle and BIN_ANGLE_MASK]; + end; +end; + +procedure Vec2_Set(var out : Vec2; x, y : single); +begin + out.X := x; + out.Y := y; +end; + +procedure Vec2_Zero(var out : Vec2); +begin + with out do begin + X := 0.0; + Y := 0.0; + end; +end; + +procedure Vec2_Add(var out : Vec2; const a, b : Vec2); +begin + with out do begin + X := a.X + b.X; + Y := a.Y + b.Y; + end; +end; + +procedure Vec2_AddTo(var out : Vec2; const v : Vec2); +begin + with out do begin + X := X + v.X; + Y := Y + v.Y; + end; +end; + +procedure Vec2_Sub(var out : Vec2; const a, b : Vec2); +begin + with out do begin + X := a.X - b.X; + Y := a.Y - b.Y; + end; +end; + +procedure Vec2_SubFrom(var out : Vec2; const v : Vec2); +begin + with out do begin + X := X - v.X; + Y := Y - v.Y; + end; +end; + +procedure Vec2_Scale(var out : Vec2; const a : Vec2; n : single); +begin + with out do begin + X := a.X * n; + Y := a.Y * n; + end; +end; + +function Vec2_Distance(const a, b : Vec2) : single; +var + j, k : single; +begin + j := b.X - a.X; + k := b.Y - a.Y; + Vec2_Distance := Sqrt((j * j) + (k * k)); +end; + +function Vec2_DistanceSqr(const a, b : Vec2) : single; +var + j, k : single; +begin + j := b.X - a.X; + k := b.Y - a.Y; + Vec2_DistanceSqr := (j * j) + (k * k); +end; + +function Vec2_Dot(const a, b : Vec2) : single; +begin + Vec2_Dot := (a.X * b.X) + (a.Y * b.Y); +end; + +function Vec2_Length(const a : Vec2) : single; +begin + with a do begin + Vec2_Length := Sqrt((X * X) + (Y * Y)); + end; +end; + +function Vec2_LengthSqr(const a : Vec2) : single; +begin + with a do begin + Vec2_LengthSqr := (X * X) + (Y * Y); + end; +end; + +procedure Vec2_Normalize(var out : Vec2; const a : Vec2); +var + inverseLength : single; +begin + inverseLength := 1.0 / Vec2_Length(a); + with out do begin + X := a.X * inverseLength; + Y := a.Y * inverseLength; + end; +end; + +procedure Vec2_NormalizeThis(var out : Vec2); +var + inverseLength : single; +begin + inverseLength := 1.0 / Vec2_Length(out); + with out do begin + X := X * inverseLength; + Y := Y * inverseLength; + end; +end; + +procedure Vec2_SetLength(var out : Vec2; const a : Vec2; length : single); +var + scale : single; +begin + scale := length / Vec2_Length(a); + with out do begin + X := a.X * scale; + Y := a.Y * scale; + end; +end; + +procedure Vec2_SetThisLength(var out : Vec2; length : single); +var + scale : single; +begin + scale := length / Vec2_Length(out); + with out do begin + X := X * scale; + Y := Y * scale; + end; +end; + +procedure Vec2_Lerp(var out : Vec2; const a, b : Vec2; t : single); +begin + with out do begin + X := a.X + (b.X - a.X) * t; + Y := a.Y + (b.Y - a.Y) * t; + end; +end; + +procedure Mtx33_Identity(var out : Mtx33); +begin + with out do begin + m[M33_11] := 1.0; + m[M33_12] := 0.0; + m[M33_13] := 0.0; + + m[M33_21] := 0.0; + m[M33_22] := 1.0; + m[M33_23] := 0.0; + + m[M33_31] := 0.0; + m[M33_32] := 0.0; + m[M33_33] := 1.0; + end; +end; + +procedure Mtx33_RotationX(var out : Mtx33; angle : binangle); +var + s, c : single; +begin + s := SinTable[angle and BIN_ANGLE_MASK]; + c := CosTable[angle and BIN_ANGLE_MASK]; + + with out do begin + m[M33_11] := 1.0; + m[M33_12] := 0.0; + m[M33_13] := 0.0; + + m[M33_21] := 0.0; + m[M33_22] := c; + m[M33_23] := -s; + + m[M33_31] := 0.0; + m[M33_32] := s; + m[M33_33] := c; + end; +end; + +procedure Mtx33_RotationY(var out : Mtx33; angle : binangle); +var + s, c : single; +begin + s := SinTable[angle and BIN_ANGLE_MASK]; + c := CosTable[angle and BIN_ANGLE_MASK]; + + with out do begin + m[M33_11] := c; + m[M33_12] := 0.0; + m[M33_13] := s; + + m[M33_21] := 0.0; + m[M33_22] := 1.0; + m[M33_23] := 0.0; + + m[M33_31] := -s; + m[M33_32] := 0.0; + m[M33_33] := c; + end; +end; + +procedure Mtx33_RotationZ(var out : Mtx33; angle : binangle); +var + s, c : single; +begin + s := SinTable[angle and BIN_ANGLE_MASK]; + c := CosTable[angle and BIN_ANGLE_MASK]; + + with out do begin + m[M33_11] := c; + m[M33_12] := -s; + m[M33_13] := 0.0; + + m[M33_21] := s; + m[M33_22] := c; + m[M33_23] := 0.0; + + m[M33_31] := 0.0; + m[M33_32] := 0.0; + m[M33_33] := 1.0; + end; +end; + +procedure Mtx33_Mul(var out, a, b : Mtx33); +begin + with out do begin + m[M33_11] := a.m[M33_11] * b.m[M33_11] + a.m[M33_12] * b.m[M33_21] + a.m[M33_13] * b.m[M33_31]; + m[M33_12] := a.m[M33_11] * b.m[M33_12] + a.m[M33_12] * b.m[M33_22] + a.m[M33_13] * b.m[M33_32]; + m[M33_13] := a.m[M33_11] * b.m[M33_13] + a.m[M33_12] * b.m[M33_23] + a.m[M33_13] * b.m[M33_33]; + + m[M33_21] := a.m[M33_21] * b.m[M33_11] + a.m[M33_22] * b.m[M33_21] + a.m[M33_23] * b.m[M33_31]; + m[M33_22] := a.m[M33_21] * b.m[M33_12] + a.m[M33_22] * b.m[M33_22] + a.m[M33_23] * b.m[M33_32]; + m[M33_23] := a.m[M33_21] * b.m[M33_13] + a.m[M33_22] * b.m[M33_23] + a.m[M33_23] * b.m[M33_33]; + + m[M33_31] := a.m[M33_31] * b.m[M33_11] + a.m[M33_32] * b.m[M33_21] + a.m[M33_33] * b.m[M33_31]; + m[M33_32] := a.m[M33_31] * b.m[M33_12] + a.m[M33_32] * b.m[M33_22] + a.m[M33_33] * b.m[M33_32]; + m[M33_33] := a.m[M33_31] * b.m[M33_13] + a.m[M33_32] * b.m[M33_23] + a.m[M33_33] * b.m[M33_33]; + end; +end; + +procedure Mtx33_Transform2D(var out : Vec2; var m : Mtx33; var v : Vec2); +begin + with out do begin + X := v.X * m.m[M33_11] + v.Y * m.m[M33_12] + m.m[M33_13]; + Y := v.X * m.m[M33_21] + v.Y * m.m[M33_22] + m.m[M33_23]; + X := X + m.m[M33_31]; + Y := Y + m.m[M33_32]; + end; +end; + +procedure Mtx33_Translation2D(var out : Mtx33; x, y : single); +begin + with out do begin + m[M33_11] := 1.0; + m[M33_12] := 0.0; + m[M33_13] := 0.0; + + m[M33_21] := 0.0; + m[M33_22] := 1.0; + m[M33_23] := 0.0; + + m[M33_31] := x; + m[M33_32] := y; + m[M33_33] := 1.0; + end; +end; + +procedure Mtx33_Scaling2D(var out : Mtx33; x, y : single); +begin + with out do begin + m[M33_11] := x; + m[M33_12] := 0.0; + m[M33_13] := 0.0; + + m[M33_21] := 0.0; + m[M33_22] := y; + m[M33_23] := 0.0; + + m[M33_31] := 0.0; + m[M33_32] := 0.0; + m[M33_33] := 1.0; + end; +end; + +procedure Mtx33_Rotation2D(var out : Mtx33; angle : binangle); +begin + Mtx33_RotationZ(out, angle); +end; + +end. diff --git a/GDLIB/MATHFP.PAS b/GDLIB/MATHFP.PAS new file mode 100644 index 0000000..06a08b2 --- /dev/null +++ b/GDLIB/MATHFP.PAS @@ -0,0 +1,528 @@ +{ Math helper functions and lookup tables. + Fixed-point alternatives to the stuff located in the Math unit. + Gered King, 2019 } + +{ You MUST manually call 'InitTrigTablesFP' in your programs before using + any of these functions that use trig!! } + + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit MathFP; + +interface + +uses Math, FixedP; + +const + FP_PI = trunc(PI * FP_FLOAT_SHIFT); + FP_PI_OVER_180 = trunc(PI_OVER_180 * FP_FLOAT_SHIFT); + + FP_DEG_TO_RAD = trunc(DEG_TO_RAD * FP_FLOAT_SHIFT); + FP_RAD_TO_DEG = trunc(RAD_TO_DEG * FP_FLOAT_SHIFT); + + FP_DEG_TO_BIN = trunc(DEG_TO_BIN * FP_FLOAT_SHIFT); + FP_BIN_TO_DEG = trunc(BIN_TO_DEG * FP_FLOAT_SHIFT); + FP_RAD_TO_BIN = trunc(RAD_TO_BIN * FP_FLOAT_SHIFT); + FP_BIN_TO_RAD = trunc(BIN_TO_RAD * FP_FLOAT_SHIFT); + +type + Vec2FP = record + X, Y : fixed; + end; + PVec2FP = ^Vec2FP; + + Mtx33FP = record + m : array[0..8] of fixed; + end; + PMtx33FP = ^Mtx33FP; + +const + ZERO_VEC2FP : Vec2FP = (X: 0; Y: 0); + IDENTITY_MTX33FP : Mtx33FP = (m: (FP_1, 0, 0, + 0, FP_1, 0, + 0, 0, FP_1)); + +var + SinTableFP : array[0..1023] of fixed; + CosTableFP : array[0..1023] of fixed; + TanTableFP : array[0..511] of fixed; + +procedure InitTrigTablesFP; + +function LerpFP(a, b, t: fixed) : fixed; +function InvLerpFP(a, b, lerped: fixed) : fixed; +function AtanFP(x : fixed) : binangle; +function Atan2FP(y, x : fixed) : binangle; +function AngleBetweenFP(x1, y1, x2, y2: fixed) : binangle; +procedure AngleToDir2DFP(angle: binangle; var outX, outY: fixed); +procedure AngleToVec2DFP(angle: binangle; var out: Vec2FP); + +procedure Vec2FP_Set(var out : Vec2FP; x, y : fixed); +procedure Vec2FP_Zero(var out : Vec2FP); +procedure Vec2FP_Add(var out : Vec2FP; const a, b : Vec2FP); +procedure Vec2FP_AddTo(var out : Vec2FP; const v : Vec2FP); +procedure Vec2FP_Sub(var out : Vec2FP; const a, b : Vec2FP); +procedure Vec2FP_SubFrom(var out : Vec2FP; const v : Vec2FP); +procedure Vec2FP_Scale(var out : Vec2FP; const a : Vec2FP; n : fixed); +procedure Vec2FP_ScaleThis(var out : Vec2FP; n : fixed); +function Vec2FP_Distance(const a, b : Vec2FP) : fixed; +function Vec2FP_DistanceSqr(const a, b : Vec2FP) : fixed; +function Vec2FP_Dot(const a, b : Vec2FP) : fixed; +function Vec2FP_Length(const a : Vec2FP) : fixed; +function Vec2FP_LengthSqr(const a : Vec2FP) : fixed; +procedure Vec2FP_Normalize(var out : Vec2FP; const a : Vec2FP); +procedure Vec2FP_NormalizeThis(var out : Vec2FP); +procedure Vec2FP_SetLength(var out : Vec2FP; const a : Vec2FP; length : fixed); +procedure Vec2FP_SetThisLength(var out : Vec2FP; length : fixed); +procedure Vec2FP_Lerp(var out : Vec2FP; const a, b : Vec2FP; t : fixed); + +procedure Mtx33FP_Identity(var out : Mtx33FP); +procedure Mtx33FP_RotationX(var out : Mtx33FP; angle : binangle); +procedure Mtx33FP_RotationY(var out : Mtx33FP; angle : binangle); +procedure Mtx33FP_RotationZ(var out : Mtx33FP; angle : binangle); +procedure Mtx33FP_Mul(var out, a, b : Mtx33FP); +procedure Mtx33FP_Transform2D(var out : Vec2FP; var m : Mtx33FP; var v : Vec2FP); +procedure Mtx33FP_Translation2D(var out : Mtx33FP; x, y : fixed); +procedure Mtx33FP_Scaling2D(var out : Mtx33FP; x, y : fixed); +procedure Mtx33FP_Rotation2D(var out : Mtx33FP; angle : binangle); + +implementation + +procedure InitTrigTablesFP; +{ populates the trig lookup tables with sin/cos/tan values for the entire + range of binary angles supported (0 to BIN_ANGLE_MASK). + fixed-point version of Math.InitTrigTables. } +var + angle : binangle; + r, s, c : single; +begin + for angle := 0 to BIN_ANGLE_MASK do begin + r := angle * BIN_TO_RAD; + s := sin(r); + c := cos(r); + + SinTableFP[angle] := FloatToFix(s); + CosTableFP[angle] := FloatToFix(c); + if angle <= BIN_ANGLE_TAN_MASK then begin + if (angle = BIN_ANGLE_90) or (angle = BIN_ANGLE_270) then + TanTableFP[angle] := 0 + else + TanTableFP[angle] := FloatToFix((s / c)); + end; + end; +end; + +function LerpFP(a, b, t: fixed) : fixed; +{ returns the interpolated value between the ranged defined by a and b. + fixed-point version of Math.Lerp. } +begin + LerpFP := a + FixMul((b - a), t); +end; + +function InvLerpFP(a, b, lerped: fixed) : fixed; +{ returns the 't' value used in a call to Lerp that returned the given + 'lerped' value using the range a to b (approximately, anyway). + fixed-point version of Math.InvLerp. } +begin + InvLerpFP := FixDiv((lerped - a), (b - a)); +end; + +function AtanFP(x : fixed) : binangle; +{ calculates the arctangent of X. returns the result as a binary angle. + functionally equivalent to ArcTan(). + fixed-point version of Math.Atan. } +var + a, b, c : integer; + d : fixed; +begin + if x >= 0 then begin + a := 0; + b := (BIN_ANGLE_90 - 1); + end else begin + a := BIN_ANGLE_90; + b := (BIN_ANGLE_180 - 1); + end; + + repeat + c := (a + b) div 2; + d := x - TanTableFP[c]; + + if d > 0 then + a := c + 1 + else if d < 0 then + b := c - 1; + until ((a > b) or (d = 0)); + + if x >= 0 then + AtanFP := c + else + AtanFP := -BIN_ANGLE_180 + c; +end; + +function Atan2FP(y, x : fixed) : binangle; +{ calculates the arctangent of Y/X. returns the result as a binary angle. + functionally equivalent to atan2() from the C runtime library. + fixed-point version of Math.Atan2. } +var + r : fixed; + b : binangle; +begin + if x = 0 then begin + if y = 0 then begin + Atan2FP := 0; + end else begin + if y < 0 then + Atan2FP := -BIN_ANGLE_90 + else + Atan2FP := BIN_ANGLE_90; + end; + exit; + end; + + r := FixDiv(y, x); + b := AtanFP(r); + + if x >= 0 then + Atan2FP := b + else if y >= 0 then + Atan2FP := BIN_ANGLE_180 + b + else + Atan2FP := b - BIN_ANGLE_180; +end; + +function AngleBetweenFP(x1, y1, x2, y2: fixed) : binangle; +{ calculates the binary angle between the two points. + fixed-point version of Math.AngleBetween. } +var + deltaX, deltaY : fixed; +begin + deltaX := x2 - x1; + deltaY := y2 - y1; + if (deltaX = 0) and (deltaY = 0) then + AngleBetweenFP := 0 + else + AngleBetweenFP := Atan2FP(deltaY, deltaX); +end; + +procedure AngleToDir2DFP(angle: binangle; + var outX, outY: fixed); +{ for a given binary angle, calculates a normalized 2D direction vector + that points in the same direction as the angle. + fixed-point version of Math.AngleToDir2D. } +begin + outX := CosTableFP[angle and BIN_ANGLE_MASK]; + outY := SinTableFP[angle and BIN_ANGLE_MASK]; +end; + +procedure AngleToVec2DFP(angle: binangle; + var out: Vec2FP); +{ for a given binary angle, calculates a normalized Vec2 that points in the + same direction as the angle. + fixed-point version of Math.AngleToVec2D. } +begin + with out do begin + X := CosTableFP[angle and BIN_ANGLE_MASK]; + Y := SinTableFP[angle and BIN_ANGLE_MASK]; + end; +end; + +procedure Vec2FP_Set(var out : Vec2FP; x, y : fixed); +begin + out.X := x; + out.Y := y; +end; + +procedure Vec2FP_Zero(var out : Vec2FP); +begin + with out do begin + X := 0; + Y := 0; + end; +end; + +procedure Vec2FP_Add(var out : Vec2FP; const a, b : Vec2FP); +begin + with out do begin + X := a.X + b.X; + Y := a.Y + b.Y; + end; +end; + +procedure Vec2FP_AddTo(var out : Vec2FP; const v : Vec2FP); +begin + inc(out.X, v.X); + inc(out.Y, v.Y); +end; + +procedure Vec2FP_Sub(var out : Vec2FP; const a, b : Vec2FP); +begin + with out do begin + X := a.X - b.X; + Y := a.Y - b.Y; + end; +end; + +procedure Vec2FP_SubFrom(var out : Vec2FP; const v : Vec2FP); +begin + dec(out.X, v.X); + dec(out.Y, v.Y); +end; + +procedure Vec2FP_Scale(var out : Vec2FP; const a : Vec2FP; n : fixed); +begin + with out do begin + X := FixMul(a.X, n); + Y := FixMul(a.Y, n); + end; +end; + +procedure Vec2FP_ScaleThis(var out : Vec2FP; n : fixed); +begin + with out do begin + X := FixMul(X, n); + Y := FixMul(Y, n); + end; +end; + +function Vec2FP_Distance(const a, b : Vec2FP) : fixed; +var + j, k : fixed; +begin + j := b.X - a.X; + k := b.Y - a.Y; + Vec2FP_Distance := FixSqrt(FixSqr(j) + FixSqr(k)); +end; + +function Vec2FP_DistanceSqr(const a, b : Vec2FP) : fixed; +var + j, k : fixed; +begin + j := b.X - a.X; + k := b.Y - a.Y; + Vec2FP_DistanceSqr := FixSqr(j) + FixSqr(k); +end; + +function Vec2FP_Dot(const a, b : Vec2FP) : fixed; +begin + Vec2FP_Dot := FixMul(a.X, b.X) + FixMul(a.Y, b.Y); +end; + +function Vec2FP_Length(const a : Vec2FP) : fixed; +begin + with a do begin + Vec2FP_Length := FixSqrt(FixSqr(X) + FixSqr(Y)); + end; +end; + +function Vec2FP_LengthSqr(const a : Vec2FP) : fixed; +begin + with a do begin + Vec2FP_LengthSqr := FixSqr(X) + FixSqr(Y); + end; +end; + +procedure Vec2FP_Normalize(var out : Vec2FP; const a : Vec2FP); +var + inverseLength : fixed; +begin + inverseLength := FixDiv(FP_1, Vec2FP_Length(a)); + with out do begin + X := FixMul(a.X, inverseLength); + Y := FixMul(a.Y, inverseLength); + end; +end; + +procedure Vec2FP_NormalizeThis(var out : Vec2FP); +var + inverseLength : fixed; +begin + inverseLength := FixDiv(FP_1, Vec2FP_Length(out)); + with out do begin + X := FixMul(X, inverseLength); + Y := FixMul(Y, inverseLength); + end; +end; + +procedure Vec2FP_SetLength(var out : Vec2FP; const a : Vec2FP; length : fixed); +var + scale : fixed; +begin + scale := FixDiv(length, Vec2FP_Length(a)); + with out do begin + X := FixMul(a.X, scale); + Y := FixMul(a.Y, scale); + end; +end; + +procedure Vec2FP_SetThisLength(var out : Vec2FP; length : fixed); +var + scale : fixed; +begin + scale := FixDiv(length, Vec2FP_Length(out)); + with out do begin + X := FixMul(X, scale); + Y := FixMul(Y, scale); + end; +end; + +procedure Vec2FP_Lerp(var out : Vec2FP; const a, b : Vec2FP; t : fixed); +begin + with out do begin + X := a.X + FixMul((b.X - a.X), t); + Y := a.Y + FixMul((b.Y - a.Y), t); + end; +end; + +procedure Mtx33FP_Identity(var out : Mtx33FP); +begin + with out do begin + m[M33_11] := FP_1; + m[M33_12] := 0; + m[M33_13] := 0; + + m[M33_21] := 0; + m[M33_22] := FP_1; + m[M33_23] := 0; + + m[M33_31] := 0; + m[M33_32] := 0; + m[M33_33] := FP_1; + end; +end; + +procedure Mtx33FP_RotationX(var out : Mtx33FP; angle : binangle); +var + s, c : fixed; +begin + s := SinTableFP[angle and BIN_ANGLE_MASK]; + c := CosTableFP[angle and BIN_ANGLE_MASK]; + + with out do begin + m[M33_11] := FP_1; + m[M33_12] := 0; + m[M33_13] := 0; + + m[M33_21] := 0; + m[M33_22] := c; + m[M33_23] := -s; + + m[M33_31] := 0; + m[M33_32] := s; + m[M33_33] := c; + end; +end; + +procedure Mtx33FP_RotationY(var out : Mtx33FP; angle : binangle); +var + s, c : fixed; +begin + s := SinTableFP[angle and BIN_ANGLE_MASK]; + c := CosTableFP[angle and BIN_ANGLE_MASK]; + + with out do begin + m[M33_11] := c; + m[M33_12] := 0; + m[M33_13] := s; + + m[M33_21] := 0; + m[M33_22] := FP_1; + m[M33_23] := 0; + + m[M33_31] := -s; + m[M33_32] := 0; + m[M33_33] := c; + end; +end; + +procedure Mtx33FP_RotationZ(var out : Mtx33FP; angle : binangle); +var + s, c : fixed; +begin + s := SinTableFP[angle and BIN_ANGLE_MASK]; + c := CosTableFP[angle and BIN_ANGLE_MASK]; + + with out do begin + m[M33_11] := c; + m[M33_12] := -s; + m[M33_13] := 0; + + m[M33_21] := s; + m[M33_22] := c; + m[M33_23] := 0; + + m[M33_31] := 0; + m[M33_32] := 0; + m[M33_33] := FP_1; + end; +end; + +procedure Mtx33FP_Mul(var out, a, b : Mtx33FP); +begin + with out do begin + m[M33_11] := FixMul(a.m[M33_11], b.m[M33_11]) + FixMul(a.m[M33_12], b.m[M33_21]) + FixMul(a.m[M33_13], b.m[M33_31]); + m[M33_12] := FixMul(a.m[M33_11], b.m[M33_12]) + FixMul(a.m[M33_12], b.m[M33_22]) + FixMul(a.m[M33_13], b.m[M33_32]); + m[M33_13] := FixMul(a.m[M33_11], b.m[M33_13]) + FixMul(a.m[M33_12], b.m[M33_23]) + FixMul(a.m[M33_13], b.m[M33_33]); + + m[M33_21] := FixMul(a.m[M33_21], b.m[M33_11]) + FixMul(a.m[M33_22], b.m[M33_21]) + FixMul(a.m[M33_23], b.m[M33_31]); + m[M33_22] := FixMul(a.m[M33_21], b.m[M33_12]) + FixMul(a.m[M33_22], b.m[M33_22]) + FixMul(a.m[M33_23], b.m[M33_32]); + m[M33_23] := FixMul(a.m[M33_21], b.m[M33_13]) + FixMul(a.m[M33_22], b.m[M33_23]) + FixMul(a.m[M33_23], b.m[M33_33]); + + m[M33_31] := FixMul(a.m[M33_31], b.m[M33_11]) + FixMul(a.m[M33_32], b.m[M33_21]) + FixMul(a.m[M33_33], b.m[M33_31]); + m[M33_32] := FixMul(a.m[M33_31], b.m[M33_12]) + FixMul(a.m[M33_32], b.m[M33_22]) + FixMul(a.m[M33_33], b.m[M33_32]); + m[M33_33] := FixMul(a.m[M33_31], b.m[M33_13]) + FixMul(a.m[M33_32], b.m[M33_23]) + FixMul(a.m[M33_33], b.m[M33_33]); + end; +end; + +procedure Mtx33FP_Transform2D(var out : Vec2FP; var m : Mtx33FP; var v : Vec2FP); +begin + with out do begin + X := FixMul(v.X, m.m[M33_11]) + FixMul(v.Y, m.m[M33_12]) + m.m[M33_13]; + Y := FixMul(v.X, m.m[M33_21]) + FixMul(v.Y, m.m[M33_22]) + m.m[M33_23]; + X := X + m.m[M33_31]; + Y := Y + m.m[M33_32]; + end; +end; + +procedure Mtx33FP_Translation2D(var out : Mtx33FP; x, y : fixed); +begin + with out do begin + m[M33_11] := FP_1; + m[M33_12] := 0; + m[M33_13] := 0; + + m[M33_21] := 0; + m[M33_22] := FP_1; + m[M33_23] := 0; + + m[M33_31] := x; + m[M33_32] := y; + m[M33_33] := FP_1; + end; +end; + +procedure Mtx33FP_Scaling2D(var out : Mtx33FP; x, y : fixed); +begin + with out do begin + m[M33_11] := x; + m[M33_12] := 0; + m[M33_13] := 0; + + m[M33_21] := 0; + m[M33_22] := y; + m[M33_23] := 0; + + m[M33_31] := 0; + m[M33_32] := 0; + m[M33_33] := FP_1; + end; +end; + +procedure Mtx33FP_Rotation2D(var out : Mtx33FP; angle : binangle); +begin + Mtx33FP_RotationZ(out, angle); +end; + + +end. + diff --git a/GDLIB/TOOLBOX.PAS b/GDLIB/TOOLBOX.PAS new file mode 100644 index 0000000..49223f2 --- /dev/null +++ b/GDLIB/TOOLBOX.PAS @@ -0,0 +1,513 @@ +{ Miscellaneous helpers and utilities. + Gered King, 2018 } + +{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Toolbox; + +interface + +uses FixedP; + +const + Bit0 = $0001; + Bit1 = $0002; + Bit2 = $0004; + Bit3 = $0008; + Bit4 = $0010; + Bit5 = $0020; + Bit6 = $0040; + Bit7 = $0080; + Bit8 = $0100; + Bit9 = $0200; + Bit10 = $0400; + Bit11 = $0800; + Bit12 = $1000; + Bit13 = $2000; + Bit14 = $4000; + Bit15 = $8000; + + BiosTicksPerSec = 1000.0 / 55.0; + BiosTicksPerSecFP = trunc((1000.0 / 55.0) * FP_FLOAT_SHIFT); + +type + { convenience for accessing a byte pointer as an array (cast to this) } + ByteArray = array[0..63999] of byte; + PByteArray = ^ByteArray; + WordArray = array[0..31999] of byte; + PWordArray = ^WordArray; + + { convenient way to go from pointer <-> segment/offset automatically } + PointerEx = record + case Integer of + 0: (ptr: Pointer); + 1: (ofs, seg: Word); + end; + +var + BiosTicks: word absolute $0040:$006c; + +function ByteFlipWord(x : word) : word; +function ByteFlipDWord(x : longint) : longint; +function SignInt(x: integer) : integer; +procedure SwapInts(var a, b: integer); +function Max(a, b: integer) : integer; +function Min(a, b: integer) : integer; +function Fequ(a, b: single) : boolean; +function FequX(a, b, tolerance: single) : boolean; +function ClampInt(value, low, high: integer) : integer; +function ClampFloat(value, low, high: single) : single; +function ClampFixed(value, low, high: fixed) : fixed; +function ScaleRange(value, oldMin, oldMax, newMin, newMax: single) : single; +function ScaleRangeFixed(value, oldMin, oldMax, newMin, newMax: fixed) : fixed; +function BiosTimeSeconds : single; +function BiosTimeSecondsFP : fixed; +function PtrSeg(const p: pointer) : word; +function PtrOfs(const p: pointer) : word; +procedure MemCopy(const dest, src: pointer; bytes: word); +procedure MemCopy16(const dest, src: pointer; bytes: word); +procedure MemFill(const dest: pointer; value: byte; bytes: word); +function HashString(const s: string) : word; +function PackBytes(const src: pointer; var dest: file; srcLength: word) : boolean; +function UnpackBytes(var src: file; const dest: pointer; unpackedSize: integer) : boolean; + +implementation + +function ByteFlipWord(x : word) : word; +{ returns the value with its bytes flipped, changing its endianess } +assembler; +asm + mov ax, x + xchg al, ah +end; + +function ByteFlipDWord(x : longint) : longint; +{ returns the value with its bytes flipped, changing its endianess } +assembler; +asm + mov dx, word(x); + mov ax, word(x+2); + xchg al, ah + xchg dl, dh +end; + +function SignInt(x: integer) : integer; +{ return 1 if x is positive, -1 if x is negative, or 0 if x is zero. } +assembler; +asm + mov bx, x + + xor ax, ax + test bx, bx + jz @done { if x == 0, then return 0 } + + mov ax, 1 { assume x is positive (return 1) } + and bx, 8000h { check sign bit } + jz @done { if sign bit == 0, return 1 (x is positive) } + mov ax, -1 { x is negative, return -1 } +@done: +end; + +procedure SwapInts(var a, b: integer); +{ swaps the values of a and b } +var + temp: integer; +begin + temp := a; + a := b; + b := temp; +end; + +function Max(a, b: integer) : integer; +{ returns the highest of the two given integers } +begin + if b > a then Max := b else Max := a; +end; + +function Min(a, b: integer) : integer; +{ returns the lowest of the two given integers } +begin + if b < a then Min := b else Min := a; +end; + +function Fequ(a, b: single) : boolean; +begin + Fequ := (abs(a - b) <= 0.00005); +end; + +function FequX(a, b, tolerance: single) : boolean; +begin + FequX := (abs(a - b) <= tolerance); +end; + +function ClampInt(value, low, high: integer) : integer; +{ returns the given value, clamped to fall within the low-high range. } +begin + if value < low then + ClampInt := low + else if value > high then + ClampInt := high + else + ClampInt := value; +end; + +function ClampFloat(value, low, high: single) : single; +{ returns the given value, clamped to fall within the low-high range. } +begin + if value < low then + ClampFloat := low + else if value > high then + ClampFloat := high + else + ClampFloat := value; +end; + +function ClampFixed(value, low, high: fixed) : fixed; +{ returns the given value, clamped to fall within the low-high range. } +begin + if value < low then + ClampFixed := low + else if value > high then + ClampFixed := high + else + ClampFixed := value; +end; + +function ScaleRange(value, oldMin, oldMax, newMin, newMax: single) : single; +{ takes a value that should be between oldMin and oldMax, and scales it so + that it is within newMin and newMax at the same relative position within + the new min/max range } +begin + ScaleRange := (newMax - newMin) * + (value - oldMin) / + (oldMax - oldMin) + newMin; +end; + +function ScaleRangeFixed(value, oldMin, oldMax, newMin, newMax: fixed) : fixed; +{ takes a value that should be between oldMin and oldMax, and scales it so + that it is within newMin and newMax at the same relative position within + the new min/max range } +begin + ScaleRangeFixed := FixDiv( + FixMul((newMax - newMin), (value - oldMin)), + (oldMax - oldMin) + newMin + ); +end; + +function BiosTimeSeconds : single; +{ returns the current bios tick count in seconds (time since midnight) } +begin + BiosTimeSeconds := BiosTicks / BiosTicksPerSec; +end; + +function BiosTimeSecondsFP : fixed; +{ returns the current bios tick count in seconds (time since midnight) } +begin + BiosTimeSecondsFP := FixDiv(IntToFix(BiosTicks), BiosTicksPerSecFP); +end; + +{ TODO: is there some better built-in way to do what the below two functions, + PtrSeg and PtrOfs, do? ... } + +function PtrSeg(const p: pointer) : word; +{ returns the segment portion of the memory address in the given pointer } +assembler; +asm + mov ax, word [p+2] +end; + +function PtrOfs(const p: pointer) : word; +{ returns the offset portion of the memory address in the given pointer } +assembler; +asm + mov ax, word [p] +end; + +procedure MemCopy(const dest, src: pointer; + bytes: word); +{ copy specified number of bytes from src to dest. uses a 32-bit copy + via 'rep movsd' } +assembler; +asm + push ds + + db $66,$33,$c9 { xor ecx, ecx } + mov cx, bytes + les di, dest + lds si, src + + mov bx, cx + shr cx, 2 { cx = number of dwords to copy } + and bx, 3 { bx = number of remainder bytes to copy } + + db $f3,$66,$a5 { rep movsd } + mov cx, bx + rep movsb + +@done: + pop ds +end; + +procedure MemCopy16(const dest, src: pointer; + bytes: word); +{ copy specified number of bytes from src to dest. uses 16-bit copy + via 'rep movsw' } +assembler; +asm + push ds + + xor cx, cx + mov cx, bytes + les di, dest + lds si, src + + mov bx, cx + shr cx, 1 { cx = number of words to copy } + and bx, 1 { bx = number of remainder bytes to copy } + + rep movsw + mov cx, bx + rep movsb + +@done: + pop ds +end; + +procedure MemFill(const dest: pointer; + value: byte; + bytes: word); +{ fill the specified length of memory starting at dest with the given value } +assembler; +asm + db $66,$33,$c9 { xor ecx, ecx } + mov cx, bytes + mov al, value + les di, dest + + mov ah, al { set all bytes of eax with value to fill with } + db $66 { shl ax => shl eax } + shl ax, 8 + mov al, ah + db $66 { shl ax => shl eax } + shl ax, 8 + mov al, ah + + mov bx, cx + shr cx, 2 { cx = number of dwords to set } + and bx, 3 { bx = number of remainder bytes to set } + + db $f3,$66,$ab { rep stosd } + mov cx, bx + rep stosb +end; + +function HashString(const s: string) : word; +{ computes the hash of a string, using the djb2 algorithm } +var + hash : word; + i, c, len : integer; +begin + len := length(s); + for i := 1 to len do begin + c := ord(s[i]); + hash := ((hash shl 5) + hash) + c; + end; + HashString := hash; +end; + +function PackBytes(const src: pointer; + var dest: file; + srcLength: word) : boolean; +{ packs the bytes located at the given pointer using the PackBits algorithm. + the packed output is written to the destination file as it is being + packed. srcLength is the size of the unpacked (original) data. packing + (and writing to the file) will stop once that many bytes have been read + from the source pointer. returns true on success, or false if there was + an IO error. assumes that the record size for the file being written is + set to 1. + this routine is based on PACKBITS.C from the Animator-Pro sources. } +const + MIN_RUN = 3; + MAX_RUN = 128; + MAX_BUFFER = 128; +type + PackMode = (PackDump, PackRun); +var + srcBytes : ^byte; + b, lastb : byte; + n, runStart : integer; + buffer : array[0..((MAX_RUN*2)-1)] of byte; + mode : PackMode; + fdata : byte; +label ioError; +begin + srcBytes := src; + + mode := PackDump; + runStart := 0; + + { read initial source byte to start things off } + lastb := srcBytes^; + buffer[0] := lastb; + inc(srcBytes); + n := 1; + dec(srcLength); + + while srcLength > 0 do begin + { read next byte, add it to the temp buffer } + b := srcBytes^; + inc(srcBytes); + buffer[n] := b; + inc(n); + + if mode = PackDump then begin + { check if we need to flush the temp buffer to the file } + if n > MAX_BUFFER then begin + fdata := n - 2; + BlockWrite(dest, fdata, 1); + if IOResult <> 0 then goto ioError; + BlockWrite(dest, buffer, n-1); + if IOResult <> 0 then goto ioError; + + buffer[0] := b; + n := 1; + runStart := 0; + + { detect the start of a run of identical bytes } + end else if b = lastb then begin + if (n - runStart) >= MIN_RUN then begin + if runStart > 0 then begin + { we've found a run, flush the buffer we have currently and then + switch to "run" mode } + fdata := runStart - 1; + BlockWrite(dest, fdata, 1); + if IOResult <> 0 then goto ioError; + BlockWrite(dest, buffer, runStart); + if IOResult <> 0 then goto ioError; + end; + mode := PackRun; + end else if runStart = 0 then begin + mode := PackRun; + end; + end else begin + runStart := n-1; + end; + + end else begin + { detect the end of a run of identical bytes } + if (b <> lastb) or ((n - runStart) > MAX_RUN) then begin + { the identical byte run has ended, write it to the file + (just two bytes, the count and the actual byte) } + fdata := -(n - runStart - 2); + BlockWrite(dest, fdata, 1); + if IOResult <> 0 then goto ioError; + fdata := lastb; + BlockWrite(dest, fdata, 1); + if IOResult <> 0 then goto ioError; + + { clear the temp buffer for our switch back to "dump" mode } + buffer[0] := b; + n := 1; + runStart := 0; + mode := PackDump; + end; + end; + lastb := b; + + dec(srcLength); + end; + + { the source bytes have all been read, but we still might have to + flush our temp buffer or finish writing out a run of identical bytes } + if mode = PackDump then begin + fdata := n - 1; + BlockWrite(dest, fdata, 1); + if IOResult <> 0 then goto ioError; + BlockWrite(dest, buffer, n); + if IOResult <> 0 then goto ioError; + end else begin + fdata := -(n - runStart - 1); + BlockWrite(dest, fdata, 1); + if IOResult <> 0 then goto ioError; + fdata := lastb; + BlockWrite(dest, fdata, 1); + if IOResult <> 0 then goto ioError; + end; + + n := IOResult; { clear i/o error flag } + PackBytes := true; + exit; + +ioError: + n := IOResult; { clear i/o error flag } + PackBytes := false; +end; + +function UnpackBytes(var src: file; + const dest: pointer; + unpackedSize: integer) : boolean; +{ unpacks a stream of bytes from a file into the destination buffer using + the PackBits algorithm. unpackedSize is the expected size of the + unpacked data, reading/unpacking will stop once this many bytes have been + written to the destination buffer. this function assumes that the file + will contain this much data and will not reach EOF before then. returns + true on success, or false if there was an IO error. + assumes that the record size for the file being read is 1. + this routine is based on PACKBITS.C from the Animator-Pro sources. } +var + destBytes : ^byte; + size, n : integer; + fdata, runLength : byte; +label ioError; +begin + destBytes := dest; + size := 0; + + while size < unpackedSize do begin + { read next "code" byte (run-length byte) that determines how to process + the subsequent bytes } + BlockRead(src, runLength, 1); + if IOResult <> 0 then goto ioError; + + { 129-255 = repeat next byte in file 257-n times } + if runLength > 128 then begin + runLength := 257 - runLength; + + { read the next byte and repeat it } + BlockRead(src, fdata, 1); + if IOResult <> 0 then goto ioError; + MemFill(destBytes, fdata, runLength); + + inc(destBytes, runLength); + inc(size, runLength); + + { 0-128 = copy next n-1 bytes in file as-is } + end else if runLength < 128 then begin + inc(runLength); + + { read next set of bytes directly into destination buffer } + BlockRead(src, destBytes^, runLength); + if IOResult <> 0 then goto ioError; + + inc(destBytes, runLength); + inc(size, runLength); + end; + + { 128 = no-op (does this even ever appear in any files??) } + end; + + n := IOResult; { clear i/o error flag } + UnpackBytes := true; + exit; + +ioError: + n := IOResult; { clear i/o error flag } + UnpackBytes := false; +end; + +begin + if Test8086 < 2 then begin + writeln('Toolbox unit requires a 386 cpu or higher!'); + halt; + end; +end. diff --git a/HELP.PAS b/HELP.PAS new file mode 100644 index 0000000..bf1bc4e --- /dev/null +++ b/HELP.PAS @@ -0,0 +1,139 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Help; + +interface + +procedure DoHelp; + +implementation + +uses GDGfx, GDKeybrd, GDTimer, GDEvents, Assets, Draw, Shared; + +var + page : integer; + +procedure DrawBaseHelpScreen; +begin + Cls(0); + + BlitSpritef(62, 10, titleHelp); + + DrawUIFrame(16, 60, 288, 136, uiGeneralFrame); + UseFont(@fnt); + +end; + +procedure ShowPage1; +begin + DrawBaseHelpScreen; + + PrintAt(24, 68); + UseFont(@chunkyFnt); + PrintString('OBJECTIVE'#10, 14); + + UseFont(@fnt); + PrintString('Using your thumbtack, pop more fruit than'#10'your opponent.'#10, 15); + PrintString('Each player chooses their fruit preference'#10'and they will only gain points by popping'#10, 15); + PrintString('matching fruit.'#10#10, 15); + + PrintString(' Tomatos'#10#10, TOMATO_TEXT_COLOR); + PrintString(' Grapes'#10#10, GRAPES_TEXT_COLOR); + BlitSpritef(176, 118, sprites[FRUIT_TOMATO_TILE_START]); + BlitSpritef(176+24, 118, sprites[PLAYER_TOMATO_TILE_START]); + BlitSpritef(176, 118+16, sprites[FRUIT_GRAPES_TILE_START]); + BlitSpritef(176+24, 118+16, sprites[PLAYER_GRAPES_TILE_START]); + + PrintString('New fruit plants will appear randomly. Wait'#10'until they grow into fruit before stabbing!'#10#10, 15); + PrintString(' Fruit Plant'#10#10, PLANT_TEXT_COLOR); + BlitSpritef(176, 174, sprites[4]); + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +procedure ShowPage2; +begin + DrawBaseHelpScreen; + + PrintAt(24, 68); + UseFont(@fnt); + PrintString('You have until the time runs out to pop as'#10'much fruit as you can!'#10#10, 15); + PrintString('If you are splashed by the opposite fruit'#10'being popped near you, you will lose speed'#10, 15); + PrintString('temporarily! Be careful.'#10#10, 15); + PrintString('Keep an eye out for golden fruit!'#10#10, 15); + BlitSpritef(128, 140, sprites[FRUIT_TOMATO_TILE_START+2]); + BlitSpritef(176, 140, sprites[FRUIT_GRAPES_TILE_START+2]); + + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +procedure ShowPage3; +begin + DrawBaseHelpScreen; + + PrintAt(24, 68); + UseFont(@chunkyFnt); + PrintString('CONTROLS'#10#10, 14); + + UseFont(@fnt); + PrintString('Player 1'#10, 128); + PrintString('Arrow keys to move. Spacebar to stab.'#10#10, 15); + PrintString('Player 2'#10, 128); + PrintString('A/S/D/W keys to move. T to stab.'#10#10, 15); + PrintString('Press ESC to pause and/or to exit out of'#10'an active match before the timer ends.', 15); + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +procedure DoHelp; +var + event : PInputEvent; +begin + UseLayer(BACKBUFFER_LAYER); + + page := 0; + + ShowPage1; + FadeIn; + InitEvents; + + while (page < 3) do begin + while not IsEventsEmpty do begin + event := PollEvents; + + if IsKeyReleasedEvent(event, KEY_ENTER) then inc(page); + if IsKeyReleasedEvent(event, KEY_SPACE) then inc(page); + if IsKeyReleasedEvent(event, KEY_ESC) then inc(page); + + if IsKeyReleasedEvent(event, KEY_UP) + or IsKeyReleasedEvent(event, KEY_LEFT) then begin + dec(page); + if page < 0 then page := 0; + end; + + if IsKeyReleasedEvent(event, KEY_DOWN) + or IsKeyReleasedEvent(event, KEY_RIGHT) then begin + inc(page); + if page >= 2 then page := 2; + end; + end; + + case page of + 0: ShowPage1; + 1: ShowPage2; + 2: ShowPage3; + end; + + end; + + CloseEvents; + FadeOut; + currentGameState := StateMainMenu; + +end; + +end. diff --git a/IMAGES.LBM b/IMAGES.LBM new file mode 100644 index 0000000000000000000000000000000000000000..bbe607a06c730944c1933bd666e4a8a177f94856 GIT binary patch literal 17758 zcmd6uOKj!WUB`d6$Ky;xNeh*VR2_jd3l?4kT`y{!1yC2RQB)FPixC>6i|`^yNMtdK zi`B)*Ox5T*ixeWkVnkgiQY1#Dgt^FuNKCk)HYIJRW%_^&kmlh|oO%0kU;h`M@9+HY zwLOm(u_Dpf_x}Iq{NC?#{3}oW`lrl(`8S^a#HW7d6Q7#oQ@`}I*_a-iUEqJaa6v!#bxI#k>A!;iPZfoJ_%A-*zJ2@6H{ZN+<;rWXy|%Wt z#>(^O&%f}(3un)sJ#*&FGtWH3wkMx_@`)#&c>M9lPo6wknB6ve$LxD%ubW*myJ+^3 z*?F_)&CZ&gF?+`BwAoW;vu4HBtHmp?6sxPn*|SBhR?N;84y3qHE6&dr&z~$lZP%W) z%Zs*l%2uDUqPSWVuN1{)=Pp})%@$YfYH{^a@ycqkdagLTSkz{V*^|XdgZe`ZOuTLrmu%vq zO}u0i=WXJ7n>cF|XKdmbn>cL~PuavQa1K*b%ofGTqJT=fcFitdwzahZL1*mrX$Y!a zDrPShCodGXTG$KM?CfQGcFk(562m1I!?~ii=wkTU!X}Oq^uLhk?$zSjE5+5-;>y|L z^;&Uhwpcq^T(IK2T{~x&>$bLNtMm3;)y{m}PEXqGVR069*OHd z^wUSb|IFh@zyJ2LN56k=^~m>Q*KQvD{?eC@d>ug>$a5F^M`&G;gYGG(EK zCg8U+lT08!H*oe&}?gm=Xte_NVe|sa=f`7c#Hf4EMrw6 zWnp0>t+0y_ZLZH7_OY0sP=BnB#fG$2RF7eoD~-%-BX9Aq_K0Dvm3pYx;jub02TjLC z%lv#mHh_x&vijK4qSf+nylP0Z0m2_|ZG>6~wF;(-fiLCuVK;j)31pbx#y57Hl@G7i z>sDW?)fQ{)s8$hIV#iy-YN586RYvMdi9Lq(L&lOEC=d>v(MKhxup|x_B`a9V8;SiG zTf^d_*%TJV-s9SfA!e0v-x_x8tCmlV&o2bq;)?`YxP{}?p$DXI+l0*4tX|)@bPIVk zkF7Vcs(<&TNV{&KBdKqVY(wm^&@^l2(a+aBSl$D}P5meMa=<5+RdPYwf4ioa4E%Kqcj*e$e;EfAmV*^|F9ZRln zX#T!s4&^&oBd_1WE%R`P7yl|wtEh4-;al4LF5gpBp(lK|q`AxUJxp*fIz%xi!-Vn* z_=|a*nh=zUN2Ivkv|0^eHmw;5wa5w&OY3GBBu;(YgQuRHSR#^QT=PVotrIfJCOewz zS&engtTB#oFt)f&6#e*|9+bNfO6JZjibvOxSgmLl>qYZ1{pI!E1?wMZW4YCz8CXmzOH}A3BcB< zFUi)hX;ToAvG6syZzG(uaoi;c9D*070auY|!tNY2!vrKvjoQM3e?s?!VMja~*4II@ zA@#g$pLpt%ziIaKf3R%J_D}q~_h-lU!{@9QmhGFwvjSBW;ZH0Jy?Vj3e>2abJUb7D zUA%1Bu9)oV79#mGe&6QVzgQanc=+`5ddt(Vio$7y%QSr6-}am7dY^r(yt%;&s{4?z zBGpQ4bCo!5q2KKLsxSDek)`mpa+#!;43{OCM;gqR{yA^D^=zqAXZbgL`N#|+0~qVS z;9$`o!AS^`=E%BSKfJ01_5M=#zHN!($OHGGSPw~E_F{L0t2BI9KtZ1ci?A;1!E{N& z5m;c3URkVXA)7CppqvOSIVb#XLl@o}Xnug1Q;vuYr|_G6=ntT#TgCPPYk-ZMiN`K( z;6?#BJ?%O8Jant0!BF+v4!QueNa>0B-1_7*5naqgjHx6rP)LeWMoD6wc_28Mg4+eI z3bAfApTqnbMR@lJ9$kF@WVdQ=LhU^s$G)Ey$Ed{tEg}moj|?IE4gzdqPs*FBn|~%a&x$YTaE_2C-e|k zQW=?YS@kPpQ>^Y)Q&`#s>a_tfah%puq?Qr~(uRQUqbNz&-$}~Tqcb7wY*Fw5lREFq zj_WSCGU#J5xY7e$qa?({QAs3eBU{NDBP))xQ%{HJQqTz*`Ti(2EbKN0-i3_6aZJ0- z3Fkls1Z=ED3FGo6hiS_7RKi&SLY58yRclW+dIPD z2KV1O?k>S3hfVz(SqK@mESP~N5oG|A_2gl~6h8@|k#8_QkOcD6iq}I<4~CXHyr@`g z!~HJb?rkO8(2F2*X(Lk7QK=aZV`W|2%5dUybND_aJ_^;dw`ikWdXO1to4@^N=`jzNmnOn0Ot+eD(sFg9Y z7+SlyUhaDBLqN18VRFGefCAN1N$GP#5^}^I70?kG5+8zeGL9*z;8f^KLTiIA`T_<} zhIkUL$Ch-3O?XPq;#7;%igt?`WcUDD_EFW}dVcl9CSlMrLWw>(C0*iR4{Fd}!qa1J z=t-jo4GM2v$1K-T#FlPygy99O!;qm#6q2Q4{yj8Ms)jj5!i!~+M}N5ei`Egq`Ggo*lu~`^b{ooF$KDd&LxsmB%nucAbDkO3w-Ff zG;TZoE=fX_qq_nDPlzP#C?f@ob`k%(?{ z3?lGETgV_lh9Lr!fC-o`P!9y6K6kH+7I}yQCkzrJ{!Vp_W<1<=E)I}qTR8!V7S=W8 z1T?*7lQ(*bg89Vp->GC%*a68}JQ0nQFe7l`j`r83E2756DvQu@kJJVM+N&f}V_}BL zMp+@`j#?7Psxnm>NyMF!g<{Tj$*1!f?C(@k^dD=5Xj{so(F+E+p#s6v$FC&*PPs7( zxnJo>cp)i~dl&|Fn@}vYOd0~oNTOg7@rP~v6tJnOwsYQxk!V?a4qPf%)fPL)gx?ZK zZ$%|bH6aL7$LM36ghE<@#d#e__*Zvt^Zf-8nJ&oh^H6S09kDdsalhZ< zQ|6UK8>306$W(rHY!~A7J@quEY^~7R0Z?0-a-b;&N@0K^HF0qodZ=uLrz1^W_j-r&iyedPfi!r`7_*E@w}M)MtZ z_UJP6@ZZ2*wm))7>{Xcog?zdIgB;Wt6lJ{qzRyZ_2oh~Qr;-q*D$aL!uL3{g*|NRm zw!0%|Ry(ieV6ae4s}`xe7XU3*%(^>R+~=VepsEu@hIXqGKfJn+$fElR{(W2YKxMYJ zF5BBNs#g1ROtgsF{$gatN%HzwSO!~CRp#0wMJLEU=H~tTHi;2!`WC;BY?7V8BO(=C zm0M!R5gp#6y~~`Bc;IudyWtQ)AK7O{=Co?z+lV(sL2^^?NCrDSU=BC_0J~_TjVN>= zNwI^d!koePrj28ZB_V(pQ|$_;l_nhx;p^N>I%07G~!Ig9#+AxJ5- zt*D-&J$v?MZ9`5SCZ%T@@&83bqKE zQ6qswQMMu2Fe!N)+fax}TjLvEtWsi8hYuzFE>6Mhb*}9wGLA`f@Dghddn9BovvA%y_bjeS&7_ zy>-M%9-uLkxSY9ReW^-A`y5m9aCBY5k5Qq4E~Y}yDbBxoM5mcC$O@n+aS5&Zx7~Mj z$uaIhTaHXhylG355G17fPGTE!$vlj#HLl73p*BRtO-Z($&`?g3B<4U~k{hKr!Nuph zLtZ0nW`wA7-?3p}#NyOfEZe)Lsa*CzOfoTO(iGQG#TYZd5f$k5GfE$W(9o6`Wdarx zQk{hpo&6)dVj5}LC}tt*}$LFXfk|4MXP9cxYD z+J%~tfD3{xG6cu193zWWO*G-7xc1>D)>`~5z2d;o22Xm!US=!Xjw0L#nd*@hMko}+ zpx@YNwXzL=M(|Pu@j_Ix6P;b}@fBpFUEwLL;%h8d-4JA|&|J1_Ou@aW6>q)iRFd|B zLa~p1Di}6==Ilj=)XYLHlVz9cf;suD1faN`uW;hyphV&Tl{XkAUmXm?_riec5`9+v zA{JCvD@*BAL^W38yUD?a2+@tjd>34lJZpQ=PtNdI64z6 zoTdOrF+U}YEZb-8JvldFUe>G$l~@)orOjpg41z_-e820km#K5!0h_9#cOF_T?K_;5 z`bzX%qFRFXn7EjoGZtc0B{Za|WqZ{JuN_|N9j70m;JMshX{Tj-;R*=<(MuzZXA@Rk zEZ<6~39G)sF6FoH@SQ<=xKysjTT%`9n&rB|dX6lpoXRmH>tFQ@sluK7N>KMrf5)P} z0*-ch6yH3w%?p!PV;R!yvL_LuhwUL?e2>kUTsCgX;#6#~@fxbkd`Q^wV~m~&vd=^M*ld(StM&_u_D&Q5~m04D1m9mqhQ;m zkP4l4572foT2Bt_&0ttkNJBwqTF@kBVIL#hIEvZrNyDkEmM`iUDd%@C0y0W+U=v(o zsYEJKHZL|ht&~8#Cpnh{a9%mZ!3B&*>^kgXexx~84grdktaJmfFdU+9+?9#mM~du9 zZR$^O9JII?!tdzJE`E%(VVqc|9foC~!GLOs-=t`v=RjPe4CbAw8ErBNp=ur+S{i7cF;Kbc%K$;YG8_H}WbxT16 zX)ST$d|)^vE}=)wg+T4do;#m^?Mo#kaT?Myy@;L39U__Eu&Uc zLXC#)L$W^V@6-Fci6JqUm&iIqVNy+SWaY0&R~a@^_W;1_oNmJJWjHR(3|H3pg508^ zo;PvsWP1|gP_}WV$lO|kT=i=I>}KC1vTFb_N{Oa}AH{jLWwlYPEw3GOYa>&E72I<@ zxqO_NKAb!j`qZu`TXQ>0VcavlH>eLJjG)9KPD^BO|K#z#+k{%#oZ_o%C-b>wSF-3q z5%ne`IQ3vD^16-)GKE<;C3o0TUKmQ8o{2Rr(@+K~^%{sVe7mIFWPRS}vs6Jmpl8<}$l!+{O7s2Y=H`@_R(2Xx1T> zYh?-xj$8vSlENYf%Ylm>nS`ZIJJRG~EA~A?n|li&^>tY3``dAR8O`VrY0{kR6r1rw zEKw$XK9n+@0>|7W+StzGOxGI1?+{c=YzgGWkaMVY)3_pY%2E=}BB7zrvW(ADQwcLZ zr<1!;02P4)eU=pZD57GF&dP(0fz-T^X?c^)tubgzIpSYh^3kA*3VCJfh>|ddbK`p| z=VO;AnsQHkngI3|aa+aKO23@_>%dUN42C-*Mg)qQ(*EL*RBL46Ew2Wt!$^=kV(Bh< zN;hG;b1)c4xT=(Iz_mI7e2$r%MlLxRH9XWst*XZzcRwlThagks%$=I>UtW4a7nQC% z43OUe>VHCn3X_x;HAY-T_GqP<&y|Ixr2J)oXx#Ys6kt9E&=i^19h8Hjd=4zf&b@bU zQ9d_8!8Mdn+2?eE@u?6Ue*Z<@cjM%jcL^&!lxyo3$`fTTlnL*8_E|VNdds0lk)}#R z_4F>@32aBZZh3asu9Qf}{26Y#)0jKQ z^js)nY9RrOKNpog_*D$;z2geg3B$n+49_LqX$n`;v;1EzjEqzb&mRu-!Qot6)+;FL zzk5I`Ts*N5m*h%Fqul+;7y5oZp$`l{#o_lkhxMMIsM?czY~vnV%*b?z8g+9Iw4M(W zI85xrT@N5WfKfV&(6(a^q=BT&^hif6-}izR9YbL}AI;^_c&RP1^4^dL%g+}(T6TS&j&&@>;t-it|lN82A{pjYdt7L ziz7OAk6?-TKI4AHbr52y5KRoaj>K_2!eC9aL&-|DYLpSUu+BxwxL7|&d{V14-KEWg6a+6%A`$v(;3uT!xr{Ly**QJJN6avpR>ur?b=w%yGIo%R^f@;7; z5IqWAxy-ZEQQ+tcy0HzakpcY?!R`>Wk27`BF*8Hf!|OQ;SGymZ{*Z5Et^S5|B6Ev) z#DyE7>!kxIPimkToB;`$+%q0N?|F6Y+~G_ySoVEj${B2|26Z5-8iE$wz^FOxVQe~C zspGC<=?YbBY09mXWC2_6a9&ol*-GzN#`*{Hc;J-`wEmG_ukX@0Azv$drLn|gCp4R%1 zaoeYk`=o}Wir8;!cw^O~rpzIlrqr^|Mk znJDRo=U?Hsjtt)Ay~dl%_AM`gZ}LuK%AVIm%wI9p!Hv}GywgaqC!gVOGyFR0;A-l1 zwKT)G*Li#0w|?7oGJLBdPObAcFJC}%LyDgAlRjWC~XYvynr8jn68+zNKfw^*6m4zJgK7WQLo%OjmV4`E9A27fkM1psGvf ztZ{LB2;`2J{!+D0YlKu4f!m;jrLv(*$*rk-$nigGA+gGy)~UI(a|a;UbzfxtfQ_jJgLW#s}+ zt~To^(~;=b^pp-OUMBy16(_d66eK9bqv(%xa*eQ-lu647>?MqNS_ z`bAvtj zy~hDcPZN~w3Q_msgA=bVJJNm|JnzHeU6^|xG=9Dq(fCj~!G_`lcwa^IfGr;=arbgT z9R*e;EV8P|v?lw2B>!Inw4Cn_;8jg{D!CVj?2A8x0S_4VAVNZOZB@pnxT4FS1}qe1 z=ORS=RK4m$j-p7J^{8Ohg>D~4wLR+XvvKik_x#jBXim(+O$@Dfri&cEOi;I($CsCcq8KzJRz^Qe#vUgRM60qe#(0j95mkW( z7MNVey8UMH zCVi0zm5V+lkSatVS%}h$v1u8eMTS0O9RFABQ5bHPLLfz`zh-I#a&H`>Neqw^^m%d9 zf9`te`9O~M6v!gO@&W;B!zUN7oLk{@yB^>pmzVhP0=z*}U`3$=WID&wMIyPkVz7wx z>M)8p4q_#w14aMfK(d~5g-ms8L?$iVbTl_gG-5ex>^llkEgU)-8>H}v!>z$>TDo}{ zj<%F?fI_DMWs|Ac;uiyAH05ek>C1{pc`E_k*WGFk&_$MhIJ$xSZh614ufIHqI&AJa zTZ9b1IY9b}u~7wmN`?Hj5}6J;4&--$OnEw5YU1sg%;P|Uw@Y+wsjs=u&+@QL%y_`^ zFnEXJ^{e+FiX#bCeNl)HMl`U)JLCt2DHT5bI8fm;)g=L=OOvV_G3vZ@Mx(n2Vr9>Z zRXN!Ku4{gH@xyW51s93M??+R1Dtx$$tCjsEb4?n|7UvYg7q4i``!p0)(~$d>4zaKgXVQ`i zm53`wXx)e5BBcL4P1~bI#KT`ct4?4?yyUFAFZooD3BR`xJq%tAtj>#tNXETGOX!y5 zUA)+dUVICi(40Nzs9Fd6-}F{?5AYIJLMgzXv4)#vu-EB<4nnSDH{aKL7Z`u%8N3vD zomV}^0GH`5$(&@*4z14}KJWO+NuR4X0Dv4xQFqBV>5RWl|Ej-@qYau$!e6jLbHO|8 UT(Q?6@4R=OV literal 0 HcmV?d00001 diff --git a/LEVELSEL.PAS b/LEVELSEL.PAS new file mode 100644 index 0000000..0e23f8f --- /dev/null +++ b/LEVELSEL.PAS @@ -0,0 +1,189 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit LevelSel; + +interface + +procedure DoLevelSelect; + +implementation + +uses Dos, GDGfx, GDKeybrd, GDTimer, GDEvents, + Assets, Maps, Draw, Shared, Toolbox; + +const + MAX_MAP_FILES = 127; { because i am lazy right now } + +type + FoundMapFile = record + filename : string[12]; + header : MapHeader; + end; + +var + mapFilesList : array[0..MAX_MAP_FILES] of FoundMapFile; + mapFilesCount : word; + + menuSelection : integer; + +function ReadMapFileHeader(filename : string; var header : MapHeader) : boolean; +var + f : file; + n : integer; + ident : array[0..2] of char; +label ioError; +begin + ReadMapFileHeader := false; + + Assign(f, filename); + + Reset(f, 1); + if IOResult <> 0 then begin + Close(f); + n := IOResult; { clear i/o error flag } + exit; + end; + + { validate file type by checking for expected header } + BlockRead(f, ident, SizeOf(ident)); + if (ident[0] <> 'M') or (ident[1] <> 'A') or (ident[2] <> 'P') then + goto ioError; + + MemFill(@header, 0, SizeOf(header)); + BlockRead(f, header, SizeOf(header), n); + if n <> SizeOf(header) then goto ioError; + + ReadMapFileHeader := true; + +ioError: + Close(f); + n := IOResult; { clear i/o error flag } +end; + +procedure ScanForMapFiles; +var + search : SearchRec; + header : MapHeader; + i : integer; +begin + i := 0; + MemFill(@mapFilesList, 0, SizeOf(mapFilesList)); + + FindFirst('*.map', AnyFile, search); + while DosError = 0 do begin + ReadMapFileHeader(search.Name, header); + + if search.Name <> 'TEST.MAP' then begin + mapFilesList[i].filename := search.Name; + mapFilesList[i].header := header; + inc(i); + end; + FindNext(search); + end; + + mapFilesCount := i; +end; + +procedure DrawLevelSelect; +var + i, x, y : integer; + idx : integer; + uiFrame : ^UIFrameBitmaps; +begin + Cls(0); + + BlitSpritef(80, 10, titleSelectLevel); + + UseFont(@fnt); + x := 16; + y := 70; + for i := -1 to 1 do begin; + idx := i + menuSelection; + + if i = 0 then + uiFrame := @uiTomatoFrame + else + uiFrame := @uiGeneralFrame; + + if (idx < 0) or (idx >= mapFilesCount) then + {DrawUIFrame(x, y, 288, 32, uiFrame^)} + else begin + with mapFilesList[idx] do begin + DrawUIFrame(x, y, 288, 32, uiFrame^); + DrawString(x+8, y+8, 15, filename); + SetClipRegion(x+8, y+16, x+8+288-16, y+16+32-16); + DrawString(x+8, y+16, 15, header.Name); + ResetClipRegion; + end; + end; + + inc(y, 32); + end; + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +procedure DoLevelSelect; +var + quit : boolean; + aborted : boolean; + event : PInputEvent; +begin + UseLayer(BACKBUFFER_LAYER); + + menuSelection := 0; + + ScanForMapFiles; + + DrawLevelSelect; + FadeIn; + InitEvents; + + quit := false; + aborted := false; + while not quit do begin + while not IsEventsEmpty do begin + event := PollEvents; + + if IsKeyReleasedEvent(event, KEY_ESC) then begin + quit := true; + aborted := true; + end; + + if IsKeyReleasedEvent(event, KEY_UP) then begin + dec(menuSelection); + if menuSelection < 0 then + menuSelection := 0; + end; + + if IsKeyReleasedEvent(event, KEY_DOWN) then begin + inc(menuSelection); + if menuSelection >= mapFilesCount then + menuSelection := mapFilesCount-1; + end; + + if IsKeyReleasedEvent(event, KEY_ENTER) then begin + if mapFilesCount > 0 then + selectedMap := mapFilesList[menuSelection].filename + else + selectedMap := ''; + quit := true; + end; + + end; + + DrawLevelSelect; + end; + + CloseEvents; + FadeOut; + + if aborted then + currentGameState := StateMainMenu + else + currentGameState := StateFruitSelect; + +end; + +end. diff --git a/MAINMENU.PAS b/MAINMENU.PAS new file mode 100644 index 0000000..1e75e4e --- /dev/null +++ b/MAINMENU.PAS @@ -0,0 +1,124 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit MainMenu; + +interface + +procedure DoMainMenu; + +implementation + +uses GDGfx, GDKeybrd, GDTimer, GDEvents, Assets, Draw, Shared; + +var + menuSelection : integer; + +procedure DrawMainMenu; +var + c : color; + x, y : integer; +begin + Cls(0); + + BlitSpritef(24, 10, titleMain); + + DrawUIFrame(68, 110, 184, 72, uiGeneralFrame); + UseFont(@fnt); + + { --- } + + x := 100; y := 120; + if menuSelection = 0 then begin + c := 14; + BlitSpritef(x, y, sprites[18]); + end else + c := 15; + DrawString(x+16+8, y+4, c, 'Play!'); + + x := 100; y := 140; + if menuSelection = 1 then begin + c := 14; + BlitSpritef(x, y, sprites[18]); + end else + c := 15; + DrawString(x+16+8, y+4, c, 'Instructions'); + + x := 100; y := 160; + if menuSelection = 2 then begin + c := 14; + BlitSpritef(x, y, sprites[18]); + end else + c := 15; + DrawString(x+16+8, y+4, c, 'Quit'); + + { --- } + + UseFont(@chunkyFnt); + + DrawString(94, 70, 22, 'GDR 4X4X4 CHALLENGE'); + x := 112; + y := 80; + BlitSpritef(x, y, sprites[0]); + inc(x, 24); + BlitSpritef(x, y, sprites[6]); + inc(x, 24); + BlitSpritef(x, y, sprites[1]); + inc(x, 24); + BlitSpritef(x, y, sprites[5]); + DrawString(178, 193, 22, 'BY: GERED KING, 2021'); + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +procedure DoMainMenu; +var + quit : boolean; + event : PInputEvent; +begin + UseLayer(BACKBUFFER_LAYER); + + menuSelection := 0; + + DrawMainMenu; + FadeIn; + InitEvents; + + quit := false; + while not quit do begin + while not IsEventsEmpty do begin + event := PollEvents; + + if IsKeyReleasedEvent(event, KEY_ESC) then begin + menuSelection := 2; + quit := true; + end; + + if IsKeyReleasedEvent(event, KEY_DOWN) then begin + inc(menuSelection); + if menuSelection > 2 then menuSelection := 0; + end; + + if IsKeyReleasedEvent(event, KEY_UP) then begin + dec(menuSelection); + if menuSelection < 0 then menuSelection := 2; + end; + + if IsKeyReleasedEvent(event, KEY_ENTER) then quit := true; + end; + + DrawMainMenu; + end; + + CloseEvents; + FadeOut; + + case menuSelection of + 0: currentGameState := StateLevelSelect; + 1: currentGameState := StateHelp; + 2: currentGameState := StateQuit; + end; + +end; + +end. diff --git a/MAPEDIT.PAS b/MAPEDIT.PAS new file mode 100644 index 0000000..eb20814 --- /dev/null +++ b/MAPEDIT.PAS @@ -0,0 +1,142 @@ +{$A+,B-,E+,F-,G+,I+,N+,P-,Q-,R-,S-,T-,V-,X+} + +program MapEdit; + +uses Maps; + +procedure SaveMap(const filename : string; var map : MapFile); +var + f : file; + header : array[0..2] of char; +begin + Assign(f, filename); + Rewrite(f, 1); + + header[0] := 'M'; header[1] := 'A'; header[2] := 'P'; + BlockWrite(f, header, SizeOf(header)); + + BlockWrite(f, map, SizeOf(map)); +end; + +procedure SaveSimpleMap; +const + filename : string = 'simple.map'; + data : MapArray = ( + 74,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,75, + 73,26,24,38,24,38,24,39,16,16,16,16,40,24,38,24,38,24,27,73, + 73,25,70,25,70,25,70,18,15,15,15,15,19,70,25,70,25,70,25,73, + 73,44,24,54,24,52,16,33,15,15,15,15,32,16,53,24,54,24,47,73, + 73,25,70,25,70,18,15,15,15,15,15,15,15,15,19,70,25,70,25,73, + 73,44,24,54,24,36,15,15,15,15,15,15,15,15,37,24,54,24,47,73, + 73,25,70,25,70,18,15,15,15,15,15,15,15,15,19,70,25,70,25,73, + 73,44,24,54,24,50,17,31,15,15,15,15,30,17,51,24,54,24,47,73, + 73,25,70,25,70,25,70,18,15,15,15,15,19,70,25,70,25,70,25,73, + 73,28,24,41,24,41,24,42,17,17,17,17,43,24,41,24,41,24,29,73, + 76,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,77 + ); +var + map : MapFile; +begin + FillChar(map, SizeOf(MapFile), 0); + with map do begin + with header do begin + name := 'Just a simple fruit garden'; + time := 120; + initialFruit := 10; + maxFruit := 32; + player1x := 7; + player1y := 5; + player2x := 12; + player2y := 5; + end; + map := data; + end; + + writeln('Saving ', filename); + SaveMap(filename, map); + writeln('Done!'); +end; + +procedure SaveSmallMap; +const + filename : string = 'small.map'; + data : MapArray = ( + 70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70, + 70,00,00,00,00,00,02,01,01,01,01,01,01,03,00,00,00,00,00,70, + 70,00,02,01,03,00,04,01,01,05,00,04,01,01,11,06,06,08,00,70, + 70,02,01,01,05,00,00,20,21,71,20,21,00,04,13,06,06,06,08,70, + 70,01,01,05,70,00,00,18,32,16,33,19,00,00,70,06,06,06,10,70, + 70,01,01,00,00,00,00,22,31,15,15,32,21,00,02,13,06,10,00,70, + 70,04,05,00,00,07,08,00,18,30,17,31,32,21,01,01,01,03,00,70, + 70,00,00,70,07,06,10,00,22,23,00,22,17,23,01,01,01,01,00,70, + 70,00,70,00,09,10,00,81,72,80,00,00,00,00,04,01,01,05,00,70, + 70,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,70, + 70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70 + ); +var + map : MapFile; +begin + FillChar(map, SizeOf(MapFile), 0); + with map do begin + with header do begin + name := 'Not a lot of growing space ...'; + time := 120; + initialFruit := 10; + maxFruit := 6; + player1x := 7; + player1y := 5; + player2x := 12; + player2y := 5; + end; + map := data; + end; + + writeln('Saving ', filename); + SaveMap(filename, map); + writeln('Done!'); +end; + +procedure SaveEdgesMap; +const + filename : string = 'edges.map'; + data : MapArray = ( + 70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70, + 70,70,70,00,00,20,16,16,21,00,70,00,00,00,00,70,00,20,21,70, + 70,70,00,02,03,22,17,17,32,21,00,00,00,00,00,00,20,33,19,70, + 70,70,00,04,01,03,00,00,22,23,00,70,00,70,00,00,22,17,19,70, + 70,00,00,70,04,05,02,01,03,00,07,08,00,00,70,70,00,00,25,70, + 70,00,00,70,70,00,04,01,05,70,06,06,70,02,03,70,70,00,25,70, + 70,00,00,00,00,70,00,70,02,01,13,14,05,01,01,01,03,20,48,70, + 70,20,21,00,00,00,00,00,04,01,01,05,00,04,01,01,05,18,19,70, + 70,18,32,16,21,02,11,08,70,04,20,16,16,16,21,00,70,22,23,70, + 70,22,17,17,23,04,13,10,00,00,22,17,17,17,23,00,00,00,00,70, + 70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70 + ); +var + map : MapFile; +begin + FillChar(map, SizeOf(MapFile), 0); + with map do begin + with header do begin + name := 'Growing space along the edges.'; + time := 120; + initialFruit := 10; + maxFruit := 10; + player1x := 5; + player1y := 4; + player2x := 14; + player2y := 6; + end; + map := data; + end; + + writeln('Saving ', filename); + SaveMap(filename, map); + writeln('Done!'); +end; + +begin + SaveSimpleMap; + SaveSmallMap; + SaveEdgesMap; +end. \ No newline at end of file diff --git a/MAPS.PAS b/MAPS.PAS new file mode 100644 index 0000000..e4ea8db --- /dev/null +++ b/MAPS.PAS @@ -0,0 +1,260 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Maps; + +interface + +uses Entities; + +const + SCREEN_MAP_LAYER = 2; + + SCREEN_MAP_WIDTH = 20; + SCREEN_MAP_HEIGHT = 11; + SCREEN_MAP_SIZE = SCREEN_MAP_WIDTH*SCREEN_MAP_HEIGHT; + + MAP_RIGHT = SCREEN_MAP_WIDTH - 1; + MAP_BOTTOM = SCREEN_MAP_HEIGHT - 1; + + { every tile beginning with this index should be + considered 'solid' for collision-purposes } + SOLID_TILE_START = 70; + + { inclusive start/end tile indices marking the range in which all + possible "dirt" tiles are found within } + DIRT_TILES_START = 15; + DIRT_TILES_END = 54; + +type + DirtTile = record + fruit : Fruit; + hasFruit : bytebool; + x, y : word; + mapIndex : word; + end; + PDirtTile = ^DirtTile; + + MapArray = array[0..(SCREEN_MAP_SIZE-1)] of byte; + + MapHeader = record + name : string[32]; { display name } + time : word; { match time in seconds } + initialFruit : word; { initial amount of fruit plants to spawn } + maxFruit : word; { max number of fruit/plants that can be + active. once reached, no more will spawn + until some of the existing ones are + removed } + player1x : word; { player 1 starting tile coordinates } + player1y : word; + player2x : word; { player 2 starting tile coordinates } + player2y : word; + end; + + MapFile = record + header : MapHeader; + map : MapArray; + end; + + MapToDirtTileArray = array[0..(SCREEN_MAP_SIZE-1)] of PDirtTile; + + { even though this is sized identically to the map itself, the actual + number of indices used will be less. AND these indices DO NOT + correspond to the same indices in the map itself! } + DirtTileArray = array[0..(SCREEN_MAP_SIZE-1)] of DirtTile; + +const + { if true, the map should be re-rendered to SCREEN_MAP_LAYER } + isMapDirty : boolean = false; + +var + map : MapFile; + + { a mapping of map x,y coordinates to DirtTile instances. any index + where the value in this array is nil means that that x,y coordinate + is not for a dirt tile } + dirtTileMapping : MapToDirtTileArray; + + { contains all of the dirt tiles. the indices in this array DO NOT + correspond to map x,y coordinates. use the above dirtTileMapping + array to find a dirt tile located in this array given a set of x,y + coordinates. } + { TODO: perhaps this should be implemented as a linked-list? } + dirtTiles : DirtTileArray; + numDirtTiles : word; + numActiveDirtTiles : word; + +function IsMapCollision(x, y : integer) : boolean; +function DoesEntityOverlapMapTile(const entity : Entity; + xt, yt : integer) : boolean; +procedure InitDirtTiles; +function GetUnusedDirtTileIndex : integer; +function GetRandomUnusedDirtTileIndex : integer; + +implementation + +uses FixedP, Toolbox, Shared; + +function IsMapCollision(x, y : integer) : boolean; +{ returns true if an entity-sized object located at the given x,y + coordinates (which indicate the top-left of the entity) will collide + with any 'solid' tiles on the map. } +const + EDGE = 2; +var + left, right, top, bottom : integer; + cx, cy : integer; + index : word; +begin + IsMapCollision := false; + + { TODO: something to make collision feel less "sticky" and a bit more + forgiving ... } + + left := (x+EDGE) div TILE_SIZE; + right := ((x-EDGE) + ENTITY_SIZE-1) div TILE_SIZE; + top := (y+EDGE) div TILE_SIZE; + bottom := ((y-EDGE) + ENTITY_SIZE-1) div TILE_SIZE; + + if left < 0 then left := 0; + if right > MAP_RIGHT then right := MAP_RIGHT; + if top < 0 then top := 0; + if bottom > MAP_BOTTOM then bottom := MAP_BOTTOM; + + with map do begin + for cy := top to bottom do begin + for cx := left to right do begin + index := (cy * SCREEN_MAP_WIDTH) + cx; + if map[index] >= SOLID_TILE_START then begin + IsMapCollision := true; + exit; + end else if (dirtTileMapping[index] <> nil) + and (dirtTileMapping[index]^.hasFruit) then begin + IsMapCollision := true; + exit; + end; + end; + end; + end; +end; + +function DoesEntityOverlapMapTile(const entity : Entity; + xt, yt : integer) : boolean; +{ returns true if the given entity fully or partially overlaps the boundaries + of the given map tile coordinates. the x and y coordinates given should be + tile coordinates, not pixel coordinates. } +const + EDGE = 2; +var + ex1, ey1, ex2, ey2 : integer; + x2, y2 : integer; +begin + DoesEntityOverlapMapTile := false; + + with entity.position do begin + ex1 := FixToInt(x)+EDGE; + ey1 := FixToInt(y)+EDGE; + ex2 := ex1 + (ENTITY_SIZE-1)-EDGE; + ey2 := ey1 + (ENTITY_SIZE-1)-EDGE; + end; + + xt := xt * TILE_SIZE; + yt := yt * TILE_SIZE; + x2 := xt + (TILE_SIZE-1); + y2 := yt + (TILE_SIZE-1); + + if (ey1 < yt) and (ey2 < yt) then + exit; + if (ey1 > y2) and (ey2 > y2) then + exit; + if (ex1 < xt) and (ex2 < xt) then + exit; + if (ex1 > x2) and (ex2 > x2) then + exit; + + DoesEntityOverlapMapTile := true; +end; + +procedure InitDirtTiles; +{ after a map has been freshly loaded, call this to scan the map for + all its dirt tiles. x,y coord to DirtTile instance mapping information + will be prepared as well as initializing the dirt tiles array itself } +var + mapIdx, dirtIdx, x, y : word; + tile : byte; +begin + MemFill(@dirtTileMapping, 0, SizeOf(dirtTileMapping)); + MemFill(@dirtTiles, 0, SizeOf(dirtTiles)); + + dirtIdx := 0; + for y := 0 to SCREEN_MAP_HEIGHT-1 do begin + for x := 0 to SCREEN_MAP_WIDTH-1 do begin + mapIdx := (y * SCREEN_MAP_WIDTH) + x; + tile := map.map[mapIdx]; + + { if this map location contains a dirt tile ... } + if (tile >= DIRT_TILES_START) and (tile <= DIRT_TILES_END) then begin + { set up this next DirtTile instance with coordinate info about + this map location } + dirtTiles[dirtIdx].x := x; + dirtTiles[dirtIdx].y := y; + dirtTiles[dirtIdx].mapIndex := mapIdx; + + { and add a pointer for this map coordinate index to the table } + dirtTileMapping[mapIdx] := @dirtTiles[dirtIdx]; + + inc(dirtIdx); + end; + end; + end; + + numDirtTiles := dirtIdx; + numActiveDirtTiles := 0; +end; + +function GetUnusedDirtTileIndex : integer; +{ returns the index of the next unused/inactive dirt tile from dirtTiles. + returns -1 if there is no free index } +var + idx : integer; +begin + GetUnusedDirtTileIndex := -1; + + for idx := 0 to numDirtTiles-1 do begin + if dirtTiles[idx].hasFruit then begin + GetUnusedDirtTileIndex := idx; + exit; + end; + end; +end; + +function GetRandomUnusedDirtTileIndex : integer; +{ returns the index of a random unused/inactive dirt tile from dirtTiles. + returns -1 if there is no free index } +const + MAX_TRIES = 10; { TODO: LOL, this is a bad way to do this } +var + try, idx : integer; +begin + GetRandomUnusedDirtTileIndex := -1; + + for try := 0 to MAX_TRIES do begin + idx := random(numDirtTiles); + { make sure there is no fruit in this tile ... } + if not dirtTiles[idx].hasFruit then begin + with dirtTiles[idx] do begin + { and also make sure that neither player is currently anywhere + within this tile either } + if (not DoesEntityOverlapMapTile(player1.entity, x, y)) + and (not DoesEntityOverlapMapTile(player2.entity, x, y)) then begin + { now we know for sure that this tile is clear } + GetRandomUnusedDirtTileIndex := idx; + exit; + end; + end; + end; + end; +end; + + + +end. diff --git a/MATCH.PAS b/MATCH.PAS new file mode 100644 index 0000000..6322a2b --- /dev/null +++ b/MATCH.PAS @@ -0,0 +1,237 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Match; + +interface + +function StartMatch : boolean; +procedure MainLoop; + +implementation + +uses GDGfx, GDKeybrd, GDTimer, GDEvents, FixedP, Math, MathFP, Toolbox, + Assets, Entities, Maps, Draw, Shared; + +var + menuSelection : integer; + +function StartMatch : boolean; +var + i : integer; +begin + StartMatch := false; + + if (not LoadMap(selectedMap)) then exit; + InitDirtTiles; + + UseLayer(BACKBUFFER_LAYER); + Cls(0); + + with map.header do begin + matchTime := time; + matchTime := matchTime * 1000; { time is a word, matchTime is longint } + + InitPlayer(player1, player1x*16, player1y*16, player1Selection); + InitPlayer(player2, player2x*16, player2y*16, player2Selection); + + for i := 1 to initialFruit do + SpawnRandomFruit; + + end; + + StartMatch := true; +end; + +procedure DrawPauseMenu; +var + c : color; + x, y : integer; +begin + BlitSpritef(111, 10, titlePause); + + DrawUIFrame(76, 90, 168, 56, uiGeneralFrame); + UseFont(@fnt); + + x := 92; y := 100; + if menuSelection = 0 then begin + c := 14; + BlitSpritef(x, y, sprites[18]); + end else + c := 15; + DrawString(x+16+8, y+4, c, 'Resume Game'); + + x := 92; y := 120; + if menuSelection = 1 then begin + c := 14; + BlitSpritef(x, y, sprites[18]); + end else + c := 15; + DrawString(x+16+8, y+4, c, 'Back to Main Menu'); + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +function DoPauseMenu : boolean; +var + quit : boolean; + event : PInputEvent; +begin + UseLayer(BACKBUFFER_LAYER); + + menuSelection := 0; + + DrawPauseMenu; + InitEvents; + + quit := false; + while not quit do begin + while not IsEventsEmpty do begin + event := PollEvents; + + if IsKeyReleasedEvent(event, KEY_ESC) then begin + menuSelection := 0; + quit := true; + end; + + if IsKeyReleasedEvent(event, KEY_DOWN) then begin + inc(menuSelection); + if menuSelection > 1 then menuSelection := 0; + end; + + if IsKeyReleasedEvent(event, KEY_UP) then begin + dec(menuSelection); + if menuSelection < 0 then menuSelection := 1; + end; + + if IsKeyReleasedEvent(event, KEY_ENTER) then quit := true; + end; + + DrawPauseMenu; + end; + + CloseEvents; + + { return true if the menu selection was 'quit' } + DoPauseMenu := (menuSelection = 1); +end; + +procedure MainLoop; +var + frames, fps : word; + elapsed : longint; + quit : boolean; + aborted : boolean; +begin + frames := 0; + fps := 0; + elapsed := 0; + + quit := false; + aborted := false; + isMapDirty := true; + isStatusBackdropDirty := true; + fruitSpawnTimer := 0; + + UseLayer(BACKBUFFER_LAYER); + + DrawBackdrop; + DrawAllFruit; + DrawPlayer(player1); + DrawPlayer(player2); + DrawAllParticles; + DrawPlayerStatuses; + DrawMatchStatus; + + Flip(BACKBUFFER_LAYER); + + FadeIn; + + MarkTimer; + while not quit do begin + + if Keys[KEY_ESC] then begin + WaitUntilKeyNotPressed(KEY_ESC); + quit := DoPauseMenu; + if quit then aborted := true; + + { reset timer mark, so if the pause menu is open for a long time, + our timing / elapsed time tracking doesn't time travel forward } + MarkTimer; + end; + + frameTicks := MarkTimer; + + inc(elapsed, frameTicks); + inc(fruitSpawnTimer, frameTicks); + + dec(matchTime, frameTicks); + if matchTime < 0 then matchTime := 0; + + { player 1 } + if Keys[KEY_LEFT] then MovePlayer(player1, West); + if Keys[KEY_RIGHT] then MovePlayer(player1, East); + if Keys[KEY_UP] then MovePlayer(player1, North); + if Keys[KEY_DOWN] then MovePlayer(player1, South); + if Keys[KEY_SPACE] then StabPlayer(player1); + + { player 2 } + if Keys[KEY_A] then MovePlayer(player2, West); + if Keys[KEY_D] then MovePlayer(player2, East); + if Keys[KEY_W] then MovePlayer(player2, North); + if Keys[KEY_S] then MovePlayer(player2, South); + if Keys[KEY_T] then StabPlayer(player2); + + { update state } + UpdatePlayer(player1); + UpdatePlayer(player2); + UpdateAllFruit; + UpdateAllParticles; + + + { render } + DrawBackdrop; + DrawAllFruit; + DrawPlayer(player1); + DrawPlayer(player2); + DrawAllParticles; + DrawPlayerStatuses; + DrawMatchStatus; + + + { update fps stats } + inc(frames); + + { once per second, update the FPS value } + if elapsed >= TIMER_FREQ then begin + fps := frames; + frames := 0; + elapsed := 0; + end; + + { + UseFont(@fnt); + PrintAt(0, 0); PrintInt(fps, 15); + PrintString(' ', 15); PrintInt(frameTicks, 15); + } + + { wait for vsync only if our frames are running at or beyond our + target framerate ... } + if frameTicks <= TARGET_FRAME_TICKS then + WaitForVsync; + + Flip(BACKBUFFER_LAYER); + + { forcefully end the match once the timer is done ... } + if matchTime <= 0 then quit := true; + end; + + FadeOut; + + if aborted then + currentGameState := StateMainMenu + else + currentGameState := StateResults; +end; + +end. diff --git a/RESULTS.PAS b/RESULTS.PAS new file mode 100644 index 0000000..ad7fa17 --- /dev/null +++ b/RESULTS.PAS @@ -0,0 +1,125 @@ +unit Results; + +interface + +procedure DoResults; + +implementation + +uses GDGfx, GDKeybrd, GDTimer, GDEvents, Assets, Draw, Entities, Shared; + +procedure DrawResults; +var + uiFrame : ^UIFrameBitmaps; + playerTile, fruitTile : word; + c : color; + s : string[3]; + player1win, player2win : boolean; +begin + Cls(0); + + BlitSpritef(98, 10, titleResults); + UseFont(@fnt); + + if player1.score > player2.score then begin + DrawString(120, 60, 15, 'Player 1 Wins!'); + player1win := true; + player2win := false; + end else if player2.score > player1.score then begin + DrawString(120, 60, 15, 'Player 2 Wins!'); + player1win := false; + player2win := true; + end else begin + DrawString(130, 60, 16, 'It''s A Tie!'); + player1win := false; + player2win := false; + end; + + + if player1Selection = Tomato then begin + uiFrame := @uiTomatoFrame; + playerTile := PLAYER_TOMATO_TILE_START; + fruitTile := FRUIT_TOMATO_TILE_START; + c := TOMATO_TEXT_COLOR; + end else begin + uiFrame := @uiGrapesFrame; + playerTile := PLAYER_GRAPES_TILE_START; + fruitTile := FRUIT_GRAPES_TILE_START; + c := GRAPES_TEXT_COLOR; + end; + + if player1win then + inc(playerTile, 16) + else if player2win then + inc(playerTile, 17); + + UseFont(@fnt); + DrawUIFrame(60, 90, 64, 64, uiFrame^); + DrawString(68, 98, 15, 'Player 1'); + BlitSpritef(72, 122, sprites[playerTile]); + BlitSpritef(72+16+8, 122, sprites[fruitTile]); + UseFont(@chunkyFnt); + Str(player1.score:3, s); + DrawStringf(72+16+8, 132, c, s); + + if player2Selection = Tomato then begin + uiFrame := @uiTomatoFrame; + playerTile := PLAYER_TOMATO_TILE_START; + fruitTile := FRUIT_TOMATO_TILE_START; + c := TOMATO_TEXT_COLOR; + end else begin + uiFrame := @uiGrapesFrame; + playerTile := PLAYER_GRAPES_TILE_START; + fruitTile := FRUIT_GRAPES_TILE_START; + c := GRAPES_TEXT_COLOR; + end; + + if player2win then + inc(playerTile, 16) + else if player1win then + inc(playerTile, 17); + + UseFont(@fnt); + DrawUIFrame(196, 90, 64, 64, uiFrame^); + DrawString(204, 98, 15, 'Player 2'); + BlitSpritef(208, 122, sprites[playerTile]); + BlitSpritef(208+16+8, 122, sprites[fruitTile]); + UseFont(@chunkyFnt); + Str(player2.score:3, s); + DrawStringf(208+16+8, 132, c, s); + + + WaitForVsync; + Flip(BACKBUFFER_LAYER); +end; + +procedure DoResults; +var + quit : boolean; + event : PInputEvent; +begin + UseLayer(BACKBUFFER_LAYER); + + DrawResults; + FadeIn; + InitEvents; + + quit := false; + while not quit do begin + while not IsEventsEmpty do begin + event := PollEvents; + + if IsKeyReleasedEvent(event, KEY_ESC) then quit := true; + if IsKeyReleasedEvent(event, KEY_ENTER) then quit := true; + end; + + DrawResults; + end; + + CloseEvents; + FadeOut; + + currentGameState := StateMainMenu; +end; + +end. diff --git a/SHARED.PAS b/SHARED.PAS new file mode 100644 index 0000000..13ea1f4 --- /dev/null +++ b/SHARED.PAS @@ -0,0 +1,315 @@ +{$A+,B-,E+,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+} + +unit Shared; + +interface + +uses FixedP, Entities; + +const + TIMER_FREQ = 1000; + TIMER_FREQ_FP = trunc(TIMER_FREQ * FP_FLOAT_SHIFT); + + TARGET_FPS = 70; + TARGET_FRAME_TICKS = TIMER_FREQ / TARGET_FPS; + + TILE_SIZE = 16; + ENTITY_SIZE = 16; + + BACKBUFFER_LAYER = 1; + + MAX_PARTICLES = 32; + + PLAYER_TOMATO_TILE_START = 40; + PLAYER_GRAPES_TILE_START = 60; + PLAYER_NEUTRAL_TILE = 80; + FRUIT_TOMATO_TILE_START = 0; + FRUIT_GRAPES_TILE_START = 1; + SPLASH_TOMATO_TILE_START = 10; + SPLASH_GRAPES_TILE_START = 20; + + GOLD_FRUIT_TILE_OFFSET = 2; + + TOMATO_TACK_TILE_START = 16; + GRAPES_TACK_TILE_START = 26; + + TOMATO_THUMBTACK_TILE = 6; + GRAPES_THUMBTACK_TILE = 7; + + TIMER_SPRITE = 39; + + HEAD_TO_HEAD_TILE = 5; + + TOMATO_SCORE_UP_TILE = 8; + GRAPES_SCORE_UP_TILE = 9; + + OW_TILE = 38; + + TOMATO_TEXT_COLOR = 224; + GRAPES_TEXT_COLOR = 160; + DEBUFF_TEXT_COLOR = 67; + PLANT_TEXT_COLOR = 96; + + GOLD_FRUIT_SPAWN_CHANCE = 5; + +type + GameState = (StateMainMenu, + StateLevelSelect, + StateFruitSelect, + StateHelp, + StateMatch, + StateResults, + StateQuit); + +var + currentGameState : GameState; + + selectedMap : string[12]; + player1Selection : FruitKind; + player2Selection : FruitKind; + + frameTicks : word; + fruitSpawnTimer : word; + + player1, player2 : Player; + tomatoPlayer : PPlayer; + grapesPlayer : PPlayer; + + playerAnimations : array[0..ord(Defeat)] of AnimationDesc; + playerSpriteOffsets : array[0..ord(Grapes)] of word; + thumbTackSpriteOffsets : array[0..ord(Grapes)] of word; + thumbTackRenderOffsetsX : array[0..ord(West)] of integer; + thumbTackRenderOffsetsY : array[0..ord(West)] of integer; + thumbTackPointOffsetsX : array[0..ord(West)] of integer; + thumbTackPointOffsetsY : array[0..ord(West)] of integer; + + fruitAnimations : array[0..ord(Popped)] of AnimationDesc; + fruitSpriteOffsets : array[0..ord(Grapes)] of word; + splashSpriteOffsets : array[0..ord(Grapes)] of word; + + particles : array[0..(MAX_PARTICLES-1)] of Particle; + + tomatoSplashAnimation : AnimationDesc; + grapesSplashAnimation : AnimationDesc; + stabFlashAnimation : AnimationDesc; + plantDestroyAnimation : AnimationDesc; + tomatoScoreUpAnimation : AnimationDesc; + grapesScoreUpAnimation : AnimationDesc; + owAnimation : AnimationDesc; + + isStatusBackdropDirty : boolean; + + matchTime : longint; + +implementation + +uses Toolbox; + +begin + { defaults for convenient testing purposes during development ... } + selectedMap := 'test.map'; + player1Selection := Tomato; + player2Selection := Grapes; + + + playerSpriteOffsets[ord(Tomato)] := PLAYER_TOMATO_TILE_START; + playerSpriteOffsets[ord(Grapes)] := PLAYER_GRAPES_TILE_START; + + thumbTackSpriteOffsets[ord(Tomato)] := TOMATO_TACK_TILE_START; + thumbTackSpriteOffsets[ord(Grapes)] := GRAPES_TACK_TILE_START; + + thumbTackRenderOffsetsX[ord(North)] := 5; + thumbTackRenderOffsetsY[ord(North)] := -5; + thumbTackRenderOffsetsX[ord(South)] := -3; + thumbTackRenderOffsetsY[ord(South)] := 8; + thumbTackRenderOffsetsX[ord(West)] := -8; + thumbTackRenderOffsetsY[ord(West)] := 2; + thumbTackRenderOffsetsX[ord(East)] := 8; + thumbTackRenderOffsetsY[ord(East)] := 3; + + thumbTackPointOffsetsX[ord(North)] := 7; + thumbTackPointOffsetsY[ord(North)] := 3; + thumbTackPointOffsetsX[ord(South)] := 7; + thumbTackPointOffsetsY[ord(South)] := 12; + thumbTackPointOffsetsX[ord(West)] := 2; + thumbTackPointOffsetsY[ord(West)] := 8; + thumbTackPointOffsetsX[ord(East)] := 13; + thumbTackPointOffsetsY[ord(East)] := 8; + + fruitSpriteOffsets[ord(Tomato)] := FRUIT_TOMATO_TILE_START; + fruitSpriteOffsets[ord(Grapes)] := FRUIT_GRAPES_TILE_START; + + splashSpriteOffsets[ord(Tomato)] := SPLASH_TOMATO_TILE_START; + splashSpriteOffsets[ord(Grapes)] := SPLASH_GRAPES_TILE_START; + + MemFill(@particles, 0, SizeOf(particles)); + + MemFill(@playerAnimations, 0, SizeOf(playerAnimations)); + + with playerAnimations[ord(Idle)] do begin + frames[0] := 0; + count := 1; + delay := 0; + loops := true; + base := 0; + dirLength := 3; + end; + + with playerAnimations[ord(Walking)] do begin + frames[0] := 1; + frames[1] := 0; + frames[2] := 2; + frames[3] := 0; + count := 4; + delay := 80; + loops := true; + base := 0; + dirLength := 3; + time := count * delay; + end; + + with playerAnimations[ord(Stabbing)] do begin + frames[0] := 0; + count := 1; + delay := 160; + base := 12; + dirLength := 1; + loops := false; + time := count * delay; + end; + + with playerAnimations[ord(Victory)] do begin + frames[0] := 0; + count := 1; + delay := 0; + loops := true; + base := 16; + dirLength := 0; + end; + + with playerAnimations[ord(Defeat)] do begin + frames[0] := 0; + count := 1; + delay := 0; + loops := true; + base := 17; + dirLength := 0; + end; + + + MemFill(@fruitAnimations, 0, SizeOf(fruitAnimations)); + + with fruitAnimations[ord(Plant)] do begin + frames[0] := 0; + count := 1; + loops := true; + base := 4; + end; + + with fruitAnimations[ord(Growing)] do begin + frames[0] := 0; + count := 1; + loops := false; + base := 0; + end; + + with fruitAnimations[ord(Grown)] do begin + frames[0] := 0; + count := 1; + loops := true; + base := 0; + end; + + with fruitAnimations[ord(Popped)] do begin + frames[0] := 0; + count := 1; + loops := false; + delay := 240; + base := 0; + end; + + + MemFill(@tomatoSplashAnimation, 0, SizeOf(tomatoSplashAnimation)); + with tomatoSplashAnimation do begin + base := 10; + frames[0] := 0; + frames[1] := 1; + frames[2] := 2; + frames[3] := 3; + frames[4] := 4; + frames[5] := 5; + count := 6; + delay := 80; + loops := false; + time := count * delay; + end; + + MemFill(@grapesSplashAnimation, 0, SizeOf(grapesSplashAnimation)); + with grapesSplashAnimation do begin + base := 20; + frames[0] := 0; + frames[1] := 1; + frames[2] := 2; + frames[3] := 3; + frames[4] := 4; + frames[5] := 5; + count := 6; + delay := 80; + loops := false; + time := count * delay; + end; + + MemFill(@stabFlashAnimation, 0, SizeOf(stabFlashAnimation)); + with stabFlashAnimation do begin + base := 30; + frames[0] := 0; + frames[1] := 1; + frames[2] := 2; + count := 3; + delay := 40; + loops := false; + time := count * delay; + end; + + MemFill(@plantDestroyAnimation, 0, SizeOf(plantDestroyAnimation)); + with plantDestroyAnimation do begin + base := 33; + frames[0] := 0; + frames[1] := 1; + frames[2] := 2; + count := 3; + delay := 60; + loops := false; + time := count * delay; + end; + + MemFill(@tomatoScoreUpAnimation, 0, SizeOf(tomatoScoreUpAnimation)); + with tomatoScoreUpAnimation do begin + base := TOMATO_SCORE_UP_TILE; + frames[0] := 0; + count := 1; + delay := 2000; + loops := false; + time := count * delay; + end; + + MemFill(@grapesScoreUpAnimation, 0, SizeOf(grapesScoreUpAnimation)); + with grapesScoreUpAnimation do begin + base := GRAPES_SCORE_UP_TILE; + frames[0] := 0; + count := 1; + delay := 2000; + loops := false; + time := count * delay; + end; + + MemFill(@owAnimation, 0, SizeOf(owAnimation)); + with owAnimation do begin + base := OW_TILE; + frames[0] := 0; + count := 1; + delay := 1000; + loops := false; + time := count * delay; + end; +end. diff --git a/SIMPLE.MAP b/SIMPLE.MAP new file mode 100644 index 0000000000000000000000000000000000000000..819e7e15042aede553e35e3e71bd5bebc142d622 GIT binary patch literal 270 zcmeZu43P3FEiO?=R4C5OEyzh#NGmGMEKx{LEJ{huV*rB+1}+8#26hHk1|A^x^1uMz zo>CHOK&UPN1R7wbw5O+}8wd*V1A#D@De38{BVi_CBA^HoQxGr(a`YkUz^dRXA?j2> od=OB@ug*wN9;8Z6&={c(-Ch|9O(4_~1Oja^Q`XZ5!y6vH0LWx7Y5)KL literal 0 HcmV?d00001 diff --git a/SMALL.MAP b/SMALL.MAP new file mode 100644 index 0000000000000000000000000000000000000000..854be60311a8d149bc9cd20a98269b87a1980b31 GIT binary patch literal 270 zcmZvX-3o$05QUF_t8IyCuHNbP0=`2xQ#XY@f<#FW85PvyH{)e^U1>;(0lv^s2oYexkER5X>x}ZohKPF)zT*T^=1N6u<&gl$ z%{DjiW5tk&5doQ9u2%pt)52s)Q74HtaAT#}>$5YAkX31I4JUcb*bwq(QKCpoNf$<# RX&iU0tQhlU?q5?^&<~k=Auj*` literal 0 HcmV?d00001 diff --git a/TEST.MAP b/TEST.MAP new file mode 100644 index 0000000000000000000000000000000000000000..86a01b764c1f84614b8055cab2c5cf813c96c8ca GIT binary patch literal 270 zcmeZu3{VJ3EiO^;O)St;2+7DSRsfgz5r7paEt|dwNQ`fuImS5D0^rlAfMA5@r%60*W9p1p!kaM<1dNtO~9YqD}?G o2LV<5>Wl>CL8{~gjS=e5?Uj+x1VSxAAkYRgWj%c`yy4*s0H)wDWdHyG literal 0 HcmV?d00001 diff --git a/TILES.LBM b/TILES.LBM new file mode 100644 index 0000000000000000000000000000000000000000..daa7ca74be123660fd008412a9dd745b60e03c59 GIT binary patch literal 28790 zcmeI4U2GiJmFG`?kkp55$;;S|$JPfT1&$$L4Qv(|C^nR?=l+*F zkNuUIeI@Z7`)`!C%@St2nwquW-g)%P=lFlhIeqzp>hUU=cafdkI$ zy4keZ$7a7V`@rlyvtOFMWA?V$IkPv+y3JlQd)2Jn%w4_e-hbbnKkv?+bEi+c_IBqx zaU-YQJMHf61MVkQ`jLH@v5Tkd{Hx~NRp;J!?!0s7T;;S|YIjQq+>({9+J~3y;=6YK zy#4g2_QsFwwNuvKZdcstORoK*J22qv=OugVL;LYX%bd5X?&=5b{qyepTkc%Ooo;vS z2iySzeVqU;zp<7NtmQpx`K7hIV=Zr6%QPqjstLNR7bM7~%-3RUN;sG~e?j0+=Wgq_7E@tff5A3HM_Qqe@Ylp18UY+i= zTNPm1O24rWFWSZPcK)aK(;wLzui0zuoIn4Go4(?%UUDCQ;68lMUHYZ_;JkbP=kC3? z+%Mm7=QB6|>*@KQz4po5r>?y9gWsHc^@E=rzxYPS$bW1f=st2j^Wx7>|K;1See0f9fAg6aUwG=!fnDy(6?gGHcmC(@?H{`zpK{$Vy4Rj@ zKd{nqyV7p&zi7Ywrv2=Y{p5gUp0QV-vO|}?dFayVLzmt@bm`)ukxPfpT{`rGOD`O{ z^xC0IKRtBmy+fBS9eVfDp|>s_I(6yLA?*3DzW@Cnumb+pl71ybUx^+wtrA*y*?t=1 zO=rbtZdPZJHT>IPzx}UIc5u$N@Vwpo8u$0V(750AqsIOJe7<2nU0Q71|7EdZpF#e) z?f?5%PW}h89sk3=Z~vx}wagv1AlsD5X3k{K1X(*%%cfKvx3!~|`D6Amo186sUvl)= zNy>`tc*34ATRdo1$S>PmHhCsP2WhTVdEiX8Tq@03K0k7@qvI7jcI>#>>t;{#|KPzz z+6y)rShCM_X?GS7=}eZgn%!k{a|^oAUU}t&F09#()+bw^v{uGy&EK_F0n7?vL!~xZbll^l{ZG8vx$lFR<_R?F8d2B zPcR;rhMVdWzHSqNrD<20m@wun$4G3LQ4IXXC~}vdwMkBkuPgidq+#;3>9{ihua|h9 zqnk;3%NEtK*IRwL|AF#_*KB;Xv)x|Q5SHLdv>m>UFUZOLu71o5BjG0aDuaE8q}J6G zfi{m9f>T7U2W*L=#TPuNe9n4%i(A?@(AY+u|AiHM0Z6Cerh2chTQ5^iyUGOTY_UVm zD?V#|To-p#^mW`R9}N~1v4Nu9%-Ugm{9#=C;gxLqaF(N+>FSmpJKNQj$&SC2ebDwm z<%BcSayFAYn;jp|*2dE+vXyb?H%IBlTS4RX5<-?J(!&nl#@9fs4wwD6XS=iGZQb2$ z+3~}5^|(##ZQWjUsiK#!B9iWqj?^DTpv_y1v?7g!TjFpQpS9t-fxyLa!Y z+mE|lUj|5dlWk?Z{z%&P?5^M6tp02$Y$%}W_4|#Z@7b)6`u1O0?VjabfBa$V|D1dK zl|8I9|MJhj!|mRkciHxR#I4_*d3*QHi0!-c%tJ}`|M0p$1NF$B@{y(-)9 zqVjH3uE21+v)MCeDp_|Xkv(&p;`+L_H;JC%^{EWR@{e4)=r8xXV#8IaF-I!d9WX;t z!!vNuo7qI>3}c?T(a;=ZSIkabH+St$RL)ziwZ?YKfv%oEW}rW>BCQEz9r`@wzlt?Z*fSv#1mSyTDcsUMy?b;DBEKKkg|iZz|A-(R$9 zYZB&OZM7%vSbA~)*A^Ek3l|0pg$a*IS`!d$u?FuzY+>h++C=z;;4LAZOt*9pA9;*M z1?cG+ApEdgUNTn%$F*xPvy(0D-&O0$leBjF)&&b%gD0H-Ub1G;aCfkH*P6k@JwjoU z+XKstvE5+Pyt!;}CJ7QvWqti-wEwttWaa6p$;qji+1XO5Twbwsap2m=sN#{6?Jpla z`to;=9qZ^gd6M?dcG^ER*Xo{dPm(V1<%-o7n*j3l=N2ngD>Q**Xc#C`NRUl()1k=` zAkCS!8>_8hi_TdF=r(@~A!}LAw#Z~ut#Kfw1Gm=Nf^4%OPfgEMN{LzSGFplw`D-5+ zM~XFT7U-ATzgy`@96QO8&f~|fecXAxbHS3WPdpI-J1i^Qj0F3ezqSbQ=NGvHC`A0*L(3hsx}75+mysbwT&;10^`P0`6}M%x z<(X+OgPTpvLD;qzM+WkI2J*z>rjy@o_hPtXiC0c?u=9BPF+T0bI+rc=`rp{^m(4v< z(=_l6{>9oi+}BczkubGkH<&6Q3vw=S>$otva91)~vd~wkdCOh#Q(+mEpR%dEqxB=~ z=w3o}pShde9o1-wj@-y@kK4+nfJtz(ZthViCet7R@*|QUak3*|8r(7W%A+T_lR3`a zX*=7oPFC6LnXbS2==Uu9C#r~`@0ukRzfn7w{>In8zQ}we3d6O0dRS&%u@>Ol!sNul zvbBKU3Vpo@(FY7}gFRU6gk`myO~_()f_wD<>rHLROn3RN2ih`U1}JI{@-0$0MCasP z53}X?NnoPm;8UZ-g zi528Yn;}`+i?z}bpnZ2dCAp{`H$+Pu$AX$(zxKNyW`0;%Cs%6m;K8Q?M0+05QiXi} zsQ~Fl3M=6hNVsSU>SZG%qD7+BTv2)?+|i1u#k=A951Ztgb}~U{yb>P6js0$G_mnVMfPOk(=?zq@Al%;EOMgHN?S zeej@{b$cPtPCk#U2)Mwa(PT|9>SUH+E&7DM5Szlj>+HYwM$q68YjPndGs>fP-0c9EcFRo9|C;?@fMMSDobg&KrCHQJgs?YG%4Dq*luSN-EwCDWhr&z4Z>=Q zhNyi}Mn|}+%mskd?eWfN!TV)I_T*&cl>m&)hV6{jyI)6yc49^FWZ=K8HP{f`HNRBq zm&QhQ5rIGAPGKeiMG`}icintfv5p*uxpH+LUr4yX(T<>CeH3V`$L&NwtiZ({N4NTv zeUzv^8F=@ULVZLz{I0JQu6m$haPt-}liy@F$tt)J@|GLfe=SqSH>pre!yfLtPr%`< zs#VBWsB%WPsq^`++ekJ%T_$QWgc zQSqRCP;e@D2~XU3GHFjeebW+8J^fGCq{~B=7`rr0h+JF)g>3PXMrU#-JL)dq9(6e= zNsfujh5M;&ZtU_+4lOBvQ#Lo1m?qhno}HYWo(U{9Gc`3$ifU$Rdd2(^zJ6h@fkuW4 zl7J1U8!71ByQF^y^TF~Z*#FOM-_smRBqs5YnnYpsimS*P`7HoQQ zdUk%HW-X-|vb?lGe|(-7S(WQ8{k^THv%)WS<0*EgTfEoD--z(89*FjnoOnG%J?2Jh zW7M;W+}P}Bl8kQ6+)PUe{lP#{-+_`8I$Z+e+KgUvOaL=(v{h6M2WwMvODassgf;Q1Jc8BV1pYLR4OksNw_UCLqV2btKgrOo1j7Bzk+rzce3W33KYol-0_rl_B=os-&8YQAbO3p09s}$M2 z?@*M8D6N=@+}}M%)xdQuNB+kvN${)T{8M;|g3-r%xDA?_oxwO+JmSJTr~rQ!gPjT{ zZ5k_qR*A}{OEQIur8Pfu|4VIOa|iW|fZ9R#oGo&{w2)lfj|kkbEiN#J+=F@@N}Dp) zU;|RCkS+=wWWNGr9G+I+>Qxf(9|gMyvkh0*_W1<>gL)3ly7}ackTy@vXnD>5(URB) zN@fx;S6AYG0=q~od@VSbcn+}53*5SuRcl(|i%~Crf1=q5-qKTI+ zq(*VGOH^(td5_cD$>N`$oSM_}D%Wf$u<`x)0-K+&*>-t{Ij~RRE3n|{*(<{QTw$cRr zB-vUnlU=}f98|ej_7bG|E^|lJ6w=09*=Lz;2@w_bWRkTOvhbbt2V=JC4LCP8H)=gZ zYAj@Sets5nU8vZ0IXSjz8S#@dtj1};;&^qNt?0(8W6=?Z6_%~UYQtw(i8LBXnlvWy z9DX>lh{h9Tm=X+f;a&!*wYQW_fh}`0`>_m_=QVY)fQ7Q)SmF4sxti@2rg_%WJa)`? z84xq*7N=X9CUijyX6FURO{ZpAbi{!YE>|(S^(MAZF8`iccO+jnqlc(e+LP~9_>fC; z-a=&p%h7Bv$2c)hmrIXkG1xfL@=%U|;T_XlLgxCYEVUG3C17af?@*8>uF9ZU+t_Rg z7fi6jJ%oW)p#P2qh0Wc{?w94=k0SytiJgkbU`| zKT?22<_CGCP8%%JKU7C%Jy_5Gy_aK*XV_z7s2L*Yk@8&IjaiRZ`lmhw#0SI_scSZt zI8X!qeXk~nz=)&*3~jK5S0b#he-ND>$VoV_--m*g(mjf#B}C=M!W|yodyeS2 z;d0}#h7&~)Sbof5(3kGd4;9GPxxO9BJOV4-%U0sz_1w^CX^9CmWMKq zxB`@sZ(RRK0oPwZhrkOBNa5X~Dq z2=6ha#mIAh781TCy>qhu7#Z1-0#Lv+jGE|cP#Bu~rK;f(_#e}W#?UCXnnvEpdw%Ab9h3tc>keUC46H=h z5F$K+ZDI67*b1f&(Hlf3p&jA+hDIQI9tlK`YV$ni^2lyWxQzeQ<-(A?MdyoviI64EsMIR>_NT>Lh?hJ_eCO-UD@TM-Ys1k;Jst)a8N!;#EpM00U>lH)JvqoS7yu1U3^W4@ zADBDVo*Eobcr)Jn()zS~M9(yl__Ra;K#3w5PVcVdZWTXBAms3Hl=5RKURlcFP=r%j zUG>cOo{C);plf-2#xQhE7)LOFGL}RKCYRNLGKmfO0b&G!cnIZi(S_6yYXl#g$Dt`G zimstA(KUQP9M9xCR6O1`;N$=rhbMoVjr&q+hgdP|SJ(s0~y9!+12g}l=H3C-8C!%EZ=LjkR_L(I0O-$hX7bcB{X$E(B zja{kb_9#S5UB;A4jdxl7i0GxQWouFCa{rr$K6szb|6Ro-!nJ6)qjVT*%c`#x7G zliDBEUOo3B*HxFJ`-De(9i8;v(HU6KIchg}jC6yvbo1V0-}~ONSN7I;B`h9M!Df}$ z2r|Juj5X`ptD`%|Jkt{08za321<|lks_hedl(+B5x^^7ZSI4?xkG-N{#~=n%ys*bO zW7DHMJmFDiqwpD#22bHUx0$oFBFUttw~*jBARKHa6ez$3loZ z=?pq}^YEzf@py~cQFoO3oHci4tjoGG3(){9mJvuMZ9b&t zikn>oLo^;;L~^+RTXLXCGH}2Pjzoqo9$z5Zd^EDNM^1d_v()_Tvm|FbtYw?luU$V^uEV`kqYY~ z$fL2)E_raZw@o&$vF&CUU#^TM6w=8Be5Tq=*orS#@VPlUA@h_Q#V}dzLFYIft~ns& zX#4iJgCknPO42EU{1f~@aYQsrG{$nJwb6QsA<9a`rl7-n2g*FRa=`q0gyZ!3u#`V>(M;IZ!5{5w4_4c!p1W{(2 zmye?l)N|7vBt%L){5@rLBBiTzXrrn>Smjzwx*;IOK{GwZ1amXrSn`%Uce*lK3R&JQ z|IMA)rVtyB+>0~DzY)kf=yiA%e=qsF{@Zom;d3M4a2FJQ2Z+8hk(l&4_*^UKY+b4w%g9clh`w zwCwO33e76Qln9Shl9Ocyh-;Aka?Q`Ej;e;fl-$)fd(L~IK$i=3Fu@Or);DpidJnHy zeJ*ovC45rDYUGY4{Kh6_S9Bw*PfeC5J%mZ`7}ThRrgDi=@~9*S5v^N7J%XjmlX4l7 zOsM07Jh{O<;?Suwe)O`w)Uog$R#&XA@!}skVHlw!)@kg?+62FnmbE9b8XO^g*XQy7LaR#z`we?hi(G<!4|nCf_x4h4|$rMglF92P8>R@gQJ9VYAm9B(uzUL8!-isNfOOiO?|JL=zT7O9XUM zbLFir=j|=}Mul~lBk181``9>@je;&PB$$B8?P#nNR4NrsP6?nC#XVZtdG-1e*Puqa zlz@PgzvM)gJ3smI0x#P(f2cfFrb`AwjB3QHnsWMmmGa;I-kOIoo9?YWwjnlxJ4_Ui z_0WRHsju>`@QIFCSumPXQcHm`Y~=32LjkBzCcR4effYEVS`LO%coFAvUWf$9n3@PHocp8| zU;OmdpX1}A99(V6m7RRb8vNMEHXqG9A=03+H^MO0h1Q&p;uA!$$PvloCRXclXip<& zNWg2;2pMT}qXbGKP9N5*T%<-+q;6$tz!l#lhM+zj=t2kP$JZ5VjtE4R<4!CL`D692 zXEQQ562KeGHSUIW5i$W5WlV_V$2}&|7m*QC7h2Yn;n3k~3ULJ!+cejH$_2`=8gCcO zxh{>X3{svKO-L&~#%d?5iVM|MIS`-FSdABkPuchkO_Zov zP20e7Hn5iHHW*}#!mkme5~^AyERM+ug;@E0w01WpG81bU>Z%RMVmM*GXZ87k&+)9~ ze1vlYOk^&w&M=Vkvn2+u=?xIJI9C&r0r4b}f_RO-Y1gb$B%AZV4Y#zxxEr+*vx}8p zD`FF$OG$rQ9GRKn*SgUMCbj7f-~fn)-&0n5Q@TorHmdrARj$P_|7C-+;!1C#&kOpw zRvtz%vJcl6PQ({e+d3KoCKF!+4L3huP;Kj$%xWvv`i)h2zcOI@f-RhfEpORewR)?v z4ALA_l6^%6iED(GV$DyPj;e;Lie7bo&!IflhAtQKpx63>^-UbxIvOIAY(!UJuc^Lb zpC7HyuUj=P_j=)qOO%4Hl6*(B^0~!AhE%anD_TMbV0>`vvq9PbG3iL-6NA-zU#*v4 z@%M*+?0|I?`VH)@cvs?w6~Hs>T`&o2(3|9XZr8b zE2xoWi+-A$cz-p0tK*~>ns`aq5}t$MztMwhlpI)rF=UkW&W zr~gmG6D}&#%W}SJ_>4z`4oE8aQAjHIQWo#mA4vty(QL`~35C(0<=~3wjIFDNR6;T7 ze-KqGl1f0~u1G4uD_;Ag4R{d;WzbG40lRa)t)h2M&nB~H&;HMBYW(ow@sGmdc38}W zMTJzw=KSNgdVTb4bEfNTSLW>5-*L%HFZq5b)DMOFp{VdWB5LoIwjZt}TY!#2s>;i$ zXZ1|FD-(1jGG~|hBO$jRu<=5z){i`droFD(z(7K0)xaz^K2=^;V#JK_v8?_8ia!4T zS>6vCuN}5=egO7omDSG!w_HjMm(q*mp@i}MR}(V^=xSFwm&xVM*0L>_z)LS-2K=Jw z3#sxWA29rxbY>aN$0F>?p5>JR{qM@~H)A3p5aFe7jn}f(@utJRUS$V~!uI8Cb5va# zZ@zC^-6gBlP=p7Qp)e$_KTi%{ZF2qCo?rYvWQMl=*x5{%e6^)06Bk@_QT!Qp879&o7ctko*xc+dPGqUFO9H_$Ar##2eGct@x9(B)~) zLq){X_6UFAC;E?=0j9@a_Brgnyac%Kl>PXuW1dVrj<2^dfj#S&WA88v$>~DQ* z90fe^z}hL;1%NguZ)t^7zgX(e@jL(@&4rGjk_dTDD17V(g0m@!739)bqGm5K-c}n= z9Py@TRDn%BZsn%|I&Mdn#&wYMHf>ou7WRe!K8TPM3M(Oz0+n2=Cqlh&faokm#KdYn zW=CnlWq5y48(@MW_qu}>#hS{U&795Eya6%=e7sNiBC1+YA@i&A%!0nsD|RNjCUg!t z!=UCR(G_Zr*c|C4CdKtRCMPyBm)+^7K~s@Cizw;taYPA@B*ytwWW&yOj$lfBab)wI zhHDyj8m_53!i$bTtVN8EfDv=sz@sO;h^LBmlDbla>I=mRopva5(7VkuM3E{9?A@nd zd8{g38mF#!Oma4fthKZHi-LmGc7)G3e`BTA-4gHB*!6JRB6+v13cuXFtxgYW4?FPf zQC}PAXLS^^WRjttj>^cin7pJxFS}44&(NuP6DBDmlE!>;D`Qpap<%{BmMocKSA(S0 zY~^f?-(4cdI5v4?Je1LmH-&qWk-wyfvk1nGDOEjjxGfl8jw@byRn@ zPHGrJmYR&{qo?G(eKkKPNXA5nILpH~%YiUkqG5^NK5-YBr*74>JjLSuT-MX=FaYrD zXOuo(W&Ri(?EDUh(owd6784!kPkRWsuY%739oNaJ{J!0vsy1Cp5RcCb4;dPhFAn-5 z59UcTNMOX|>%7yNFkL$fz!#Ere8<30RIy6_Xb&Gp^Y?`vlN z6k^MDb;3OKu&Y$(^I)dDwAX;e_N?qqJicd3;%~?oBaXQglg*7;=L2_g5+2y>zkR)H>}z1+k7A__ktrZgWcZ$QoC}T?cLJ_c!HoJL)bB+Uj)& ziQ7~AS1gM(xyNR!qI(5|6Nsf{C%!_oRhbmA!05A+p=gjWVsbTZcn%Te2Jd zhMTDJVCK_sn&$|3t^0B!!fc)TNp`qhu0aZe}qJp{o>T%Y@BKJ_V` zd^D08ri+iBNk0AX9W4BF>7Wpb@a&%~!j~P4q`uU_pQ?jTSxl^jVHOigeEOqj63?>Y z|IrfHb!0I-QuIfXdmhe4|LhJHLIee{f#6vd`a>f4GdoCLUs%9nE#k2X1w2*}kM-=c oc&t4S<+0rL%EHw}InPSrYEjO!^6b?;59d71)*P~X2ybcs2VBFDx&QzG literal 0 HcmV?d00001