{$mode objfpc} {$h+} {$modeswitch duplicatelocals}
{$warn 5024 off} // hint: parameter not used
{$define demonstrate} // дефайн для ideone-демонстрации вместо интерактива
program quest;
uses
SysUtils;
function IfThen(cond: boolean; const ifTrue: unicodestring; const ifFalse: unicodestring = ''): unicodestring;
begin
if cond then result := ifTrue else result := ifFalse;
end;
type
TWorld = class;
TScene = class
type
FlagEnum = (Scene_IsEnding);
FlagSet = set of FlagEnum;
protected
world: TWorld;
procedure HandleDisplay; virtual; abstract;
procedure HandleCommands; virtual;
function HandleFlags: FlagSet; virtual;
function Command(const cmd, desc: unicodestring): boolean;
end;
TWorld = class
// Логика насчёт сцены и её смены.
scene, pendingSwitchTo: TScene;
turnedOff: boolean;
constructor Create(startingScene: TScene);
destructor Destroy; override;
function Alive: boolean;
procedure Display;
procedure SendCommand(const cmd: unicodestring);
procedure SwitchTo(scene: TScene);
procedure TurnOff;
private
commandMode: (AwaitingCommandsToDescribe, AwaitingCommandToPerform, CommandPerformed);
commandToPerform: unicodestring;
hasCommandsExceptEnter: boolean;
procedure CompleteSwitching;
public
// Всякие персистентные штуки.
type
SexType = (Sex_Anal, Sex_Irrumatio, Sex_Vaginal);
SexTypes = set of SexType;
var
sexProceed: SexTypes;
erectOnce, doorOpened: boolean;
end;
procedure TScene.HandleCommands;
begin
end;
function TScene.HandleFlags: FlagSet;
begin
result := [];
end;
function TScene.Command(const cmd, desc: unicodestring): boolean;
begin
result := false;
if cmd <> '' then world.hasCommandsExceptEnter := true;
case world.commandMode of
AwaitingCommandsToDescribe: writeln(IfThen(cmd = '', '<ENTER> ', '(' + cmd + ') ') + desc);
AwaitingCommandToPerform:
if cmd = world.commandToPerform then
begin
result := true;
world.commandMode := CommandPerformed;
end;
CommandPerformed: ;
end;
end;
constructor TWorld.Create(startingScene: TScene);
begin
inherited Create;
SwitchTo(startingScene);
CompleteSwitching;
end;
destructor TWorld.Destroy;
begin
FreeAndNil(scene);
inherited Destroy;
end;
function TWorld.Alive: boolean;
begin
result := not turnedOff;
end;
procedure TWorld.Display;
begin
scene.HandleDisplay;
if Scene_IsEnding in scene.HandleFlags then exit;
writeln;
commandMode := AwaitingCommandsToDescribe;
hasCommandsExceptEnter := false;
scene.HandleCommands;
if hasCommandsExceptEnter then write(LineEnding + '> ');
end;
procedure TWorld.SendCommand(const cmd: unicodestring);
begin
if Scene_IsEnding in scene.HandleFlags then
begin
TurnOff;
exit;
end;
commandMode := AwaitingCommandToPerform;
commandToPerform := cmd;
scene.HandleCommands;
if commandMode = CommandPerformed then
begin
if cmd <> '' then writeln;
end else
writeln('Ась?' + LineEnding);
CompleteSwitching; // обработка команды могла вызвать SwitchTo
end;
procedure TWorld.SwitchTo(scene: TScene);
begin
if scene.world <> nil then raise Exception.Create('Нет, создай новую сценку.');
// SwitchTo не переключает состояние сразу, потому что это предполагает освобождение старого состояния,
// которое прямо сейчас выполняет какой-нибудь HandleCommand и может не ожидать выдёргивания почвы у себя из-под ног.
FreeAndNil(pendingSwitchTo);
pendingSwitchTo := scene;
end;
procedure TWorld.TurnOff;
begin
turnedOff := true;
end;
procedure TWorld.CompleteSwitching;
begin
if pendingSwitchTo <> nil then
begin
FreeAndNil(scene);
scene := pendingSwitchTo;
pendingSwitchTo := nil;
scene.world := self;
end;
end;
type
Scene_Prologue = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
end;
Scene_LeaveIsland = class(TScene)
protected
procedure HandleDisplay; override;
function HandleFlags: FlagSet; override;
end;
Scene_Girl = class(TScene)
constructor Create(comeFromFar: boolean);
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
private
comeFromFar: boolean;
end;
Scene_Irrumatio = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
private
stage: cardinal;
end;
Scene_Vaginal = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
private
stage: cardinal;
end;
Scene_Anal = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
private
stage: cardinal;
end;
Scene_CantOpen = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
end;
Scene_DoorOpeningSound = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
end;
Scene_DoorEntry = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
end;
Scene_GirlRevenge1 = class(TScene)
protected
procedure HandleDisplay; override;
procedure HandleCommands; override;
function HandleFlags: FlagSet; override;
private
stage: cardinal;
end;
Scene_GirlRevenge2 = class(TScene)
protected
procedure HandleDisplay; override;
function HandleFlags: FlagSet; override;
end;
procedure Scene_Prologue.HandleDisplay;
begin
writeln(
'В древней книге ты прочитал о Подземелье Королей, которое даст славу и могущество тому, кто его пройдёт.' + LineEnding +
'Когда ты приплыл по координатам, загадочный остров возник из ниоткуда.' + LineEnding +
'Ты спускаешься на берег.');
end;
procedure Scene_Prologue.HandleCommands;
begin
if Command('1', 'Исследовать остров.') then world.SwitchTo(Scene_Girl.Create({comeFromFar} true));
if Command('0', 'Покинуть остров.') then world.SwitchTo(Scene_LeaveIsland.Create);
end;
procedure Scene_LeaveIsland.HandleDisplay;
begin
writeln(
'Испуганный, ты развернулся и побежал к кораблю. Ты отплыл от острова, но так и не вернулся домой.' + LineEnding +
'' + LineEnding +
'<КОНЕЦ>');
end;
function Scene_LeaveIsland.HandleFlags: FlagSet;
begin
result := [Scene_IsEnding];
end;
constructor Scene_Girl.Create(comeFromFar: boolean);
begin
inherited Create;
self.comeFromFar := comeFromFar;
end;
procedure Scene_Girl.HandleDisplay;
function MinusArrowsPiece: unicodestring;
var
n: cardinal;
st: TWorld.SexType;
begin
result := '';
n := 0;
for st in world.sexProceed do inc(n);
case n of
1: result := 'Одна из стрелок выглядит выветренной.';
2: result := 'Две из стрелок наполовину выветрились.';
end;
end;
var
piece: unicodestring;
shineMentioned: boolean;
begin
writeln(
IfThen(comeFromFar,
'В сотне метров от берега виднеется витражный купол.' + LineEnding +
'Подойдя ближе, ты',
'Ты') + ' видишь каменную площадку и дверь, высеченную в скале.');
if world.doorOpened then
writeln('Изображение треугольника почти выветрилось, его оставшиеся фрагменты окрасились тёмно-красным.')
else
begin
piece := MinusArrowsPiece;
writeln('На двери нарисован треугольник, концы трёх стрелок направлены к его вершинам извне.' + IfThen(piece <> '', LineEnding) + piece);
end;
writeln('В центре площадки лежит голая девушка. ' +
IfThen(world.doorOpened,
'Она без сознания, но, кажется, стала более подвижной.' + LineEnding +
'Ты сомневаешься, что она оценит твой дружеский вклад, поэтому не хочешь попадаться ей на глаза.',
'Похоже, она без сознания.'));
piece := '';
shineMentioned := false;
if Sex_Irrumatio in world.sexProceed then
begin
piece := 'Рот девушки блестит на солнце, пробивающемся сквозь купол.';
shineMentioned := true;
end;
if world.sexProceed * [Sex_Vaginal, Sex_Anal] = [Sex_Vaginal] then
begin
piece += IfThen(piece <> '', LineEnding) +
'Её вагина зияет, ' + IfThen(shineMentioned,
'из неё течёт струйка вязкой жидкости.',
'вытекающая струйка вязкой жидкости блестит на солнце, пробивающемся сквозь купол.');
shineMentioned := true;
end
else if world.sexProceed * [Sex_Vaginal, Sex_Anal] = [Sex_Anal] then
begin
piece += IfThen(piece <> '', LineEnding) +
'Её анус зияет, ' + IfThen(shineMentioned,
'из него течёт струйка вязкой жидкости.',
'вытекающая струйка вязкой жидкости блестит на солнце, пробивающемся сквозь купол.');
shineMentioned := true;
end
else if world.sexProceed * [Sex_Vaginal, Sex_Anal] = [Sex_Vaginal, Sex_Anal] then
begin
piece += IfThen(piece <> '', LineEnding) +
IfThen(piece = '', 'Анус и вагина девушки зияют, ', 'Анус и вагина зияют, ') + IfThen(shineMentioned,
'из них натекла небольшая флуоресцирующая лужица.',
'лужица вязкой жидкости, натёкшей из них, блестит на солнце, пробивающемся сквозь купол.');
shineMentioned := true;
end;
if piece <> '' then writeln(LineEnding + piece);
end;
procedure Scene_Girl.HandleCommands;
var
cmdNo: integer;
begin
cmdNo := 1;
if not (Sex_Irrumatio in world.sexProceed) then
begin
if Command(unicodestring(IntToStr(cmdNo)), 'Трахнуть девушку в рот.') then world.SwitchTo(Scene_Irrumatio.Create);
inc(cmdNo);
end;
if not (Sex_Vaginal in world.sexProceed) then
begin
if Command(unicodestring(IntToStr(cmdNo)), 'Трахнуть девушку в вагину.') then world.SwitchTo(Scene_Vaginal.Create);
inc(cmdNo);
end;
if not (Sex_Anal in world.sexProceed) then
begin
if Command(unicodestring(IntToStr(cmdNo)), 'Трахнуть девушку в анус.') then world.SwitchTo(Scene_Anal.Create);
inc(cmdNo);
end;
if Command(unicodestring(IntToStr(cmdNo)), 'Открыть дверь.') then
if world.doorOpened then
world.SwitchTo(Scene_DoorEntry.Create)
else
world.SwitchTo(Scene_CantOpen.Create);
inc(cmdNo);
if Command('0', 'Покинуть остров.') then world.SwitchTo(Scene_LeaveIsland.Create);
end;
procedure NoteGirlSexActAndReturn(world: TWorld; &type: TWorld.SexType);
begin
world.sexProceed += [&type];
world.erectOnce := true;
if world.sexProceed = [Sex_Anal, Sex_Irrumatio, Sex_Vaginal] then
begin
world.doorOpened := true;
world.SwitchTo(Scene_DoorOpeningSound.Create);
end else
world.SwitchTo(Scene_Girl.Create({comeFromFar} false));
end;
procedure Scene_Irrumatio.HandleDisplay;
begin
case stage of
0: writeln(
'Губы девушки манят тебя. Ты приближаешься, чтобы облизнуть их, и чувствуешь её слабое дыхание.' + LineEnding +
'Ты не ощущаешь сопротивления, проникая языком в её рот. Твой член' + IfThen(world.erectOnce, ' снова') + ' поднимается.' + LineEnding +
'Ты завершаешь поцелуй и придвигаешься бёдрами.' + LineEnding +
'Придерживая голову девушки, ты прижимаешь член к её губам. Они распахиваются вслед за приоткрывшейся челюстью и принимают его внутрь.' + LineEnding +
'Ты начинаешь двигаться. Основание члена ритмично скользит по её податливому языку, а головка тычется в мягкое нёбо.');
1: writeln(
'Не вытаскивая члена, ты разворачиваешься и утыкаешься лбом в промежность девушки. Она слабо пахнет морскими водорослями.' + LineEnding +
'Ты обхватываешь бёдра девушки руками и с усилием просовываешь член ей в глотку. Её горло сводит судорога.' + LineEnding +
'Ты остаёшься неподвижен и прислушиваешься к ощущениям, пока её горло расслабляется.' + LineEnding +
'Ты постепенно возобновляешь движения, и через минуту уже, сквозь слюни и сбивающееся дыхание, раз за разом топишь член в её глотке по самые яйца.');
2: writeln(
'После ещё нескольких толчков ты разряжаешься внутрь.' + LineEnding +
'Перистальтика пищевода слабее, чем если бы девушка была в сознании, но, так или иначе, большая часть спермы оказывается у неё в желудке.' + LineEnding +
'Ты медленно вынимаешь обслюнявленный член из её рта.');
end;
end;
procedure Scene_Irrumatio.HandleCommands;
begin
case stage of
0: if Command('', 'Продолжать.') then inc(stage);
1: if Command('', 'Кончить в горло.') then inc(stage);
2: if Command('', 'Подняться.') then NoteGirlSexActAndReturn(world, Sex_Irrumatio);
end;
end;
procedure Scene_Vaginal.HandleDisplay;
begin
case stage of
0: writeln(
'В предвкушении ты спускаешься на колени перед промежностью девушки.' + LineEnding +
'В островке волос на её лобке застряли кристаллики соли.' + LineEnding +
'Ты гладишь девушку по нежной внутренней поверхности бёдер, и она постанывает сквозь забытьё.' + LineEnding +
'Ты раздвигаешь половые губы девушки левой рукой, а двумя пальцами правой дразнишь вход во влагалище. Немного погодя без труда проскальзываешь ими вовнутрь и аккуратно растягиваешь в стороны. Ты видишь, как потревоженные стенки влагалища слегка пульсируют, пытаясь вернуться к первоначальной форме.');
1: writeln(
'Теперь' + IfThen(world.erectOnce, ' снова') + ' совершенно готовый, ты запрокидываешь одну ногу девушки себе на плечо.' + LineEnding +
'Помогая свободной рукой, ты трёшься стволом члена вдоль её половых губ и клитора. Затем уверенно направляешь головку внутрь, и с хлюпанием смазки он наполовину погружается в её лоно.' + LineEnding +
'Ты кладёшь ладонь на живот девушки и совершаешь несколько пробных фрикций, постепенно увеличивая глубину.' + LineEnding +
'Стенки влагалища обхватывают тебя всё плотнее.' + LineEnding +
'И вот, раззадоренный, ты запрокидываешь её вторую ногу, упираешься локтями в каменный пол и начинаешь бесцеремонно трахать, доставая аккурат до шейки матки в крайней точке амплитуды.' + LineEnding +
'Купол заполняется похабными звуками соударения юных тел.');
2: writeln(
'Устав держаться на весу, ты встаёшь на голени и расставляешь ноги девушки в стороны.' + LineEnding +
'Ты продолжаешь движения тазом. Грудь девушки покачивается в такт, и ты алчно протягиваешь к ней руки. Ты впиваешься в неё пальцами; девушка в сознании вскрикнула бы от боли, но сейчас она лишь выдохнула сильнее обычного.' + LineEnding +
'На пределе ты приподнимаешь девушку за талию, погружаешь член до упора, и он, пульсируя, заполняет её горячим семенем.' + LineEnding +
'На фоне разгорячённого дыхания девушки ты прислушиваешься к отголоскам оргазма, и наконец осторожно достаёшь свой полностью обмякший член.');
end;
end;
procedure Scene_Vaginal.HandleCommands;
begin
case stage of
0: if Command('', 'Секс.') then inc(stage);
1: if Command('', 'Полапать грудь + финал.') then inc(stage);
2: if Command('', 'Подняться.') then NoteGirlSexActAndReturn(world, Sex_Vaginal);
end;
end;
procedure Scene_Anal.HandleDisplay;
begin
case stage of
0: writeln(
'Ты переворачиваешь девушку на живот. Твоему взору открываются её спина и ягодицы.' + LineEnding +
'Ты несколько раз звонко шлёпаешь по ягодицам, оставляя горящие отпечатки ладоней. Твой член давно рвётся ввысь' + IfThen(world.erectOnce, ' снова') + '.' + LineEnding +
'Ты оттягиваешь правую ягодицу, и анальное колечко послушно тянется за ней. Похоже, девушке не впервой заниматься этим.' + LineEnding +
'Ты приставляешь головку члена к анусу девушки. Ты собираешь слюну во рту, наклоняешься и даёшь ей стечь в ложбинку в месте стыка.');
1: writeln(
'Ты делаешь несколько толчков, приноравливаясь к сфинктеру. Кажется, с каждым разом он пропускает тебя чуть глубже, но в целом остаётся неприступным.' + LineEnding +
'Осмелев, ты решительно обхватываешь таз девушки руками и настойчиво, теперь уже не прерываясь, проталкиваешь член внутрь. После первых сантиметров он с неожиданной лёгкостью проходит на всю длину.' + LineEnding +
'Ты начинаешь фрикции, то и дело шлёпая по ягодицам.' + LineEnding +
'Через пару минут ты чувствуешь, что полностью освоился в прямой кишке. Тогда ты придерживаешь руками ягодицы девушки в раздвинутом состоянии и — чпок! — достаёшь член, чтобы полюбоваться зияющим результатом своих действий.');
2: writeln(
'Ты погружаешь член обратно, теперь совершенно без усилий, и ускоряешь движения.' + LineEnding +
'Ты чувствуешь себя на пороге оргазма, делаешь последнее, самое глубокое погружение и начинаешь исторгать сперму вовнутрь.' + LineEnding +
'С последней её каплей живот девушки едва слышно уркнул, словно проглатывая заряд.' + LineEnding +
'Похлопав по ягодицам вместо головы в знак похвалы, ты вытаскиваешь член. Анус уже не спешит закрываться и лишь подрагивает.');
end;
end;
procedure Scene_Anal.HandleCommands;
begin
case stage of
0: if Command('', 'Вставить.') then inc(stage);
1: if Command('', 'Продолжить и кончить.') then inc(stage);
2: if Command('', 'Подняться.') then NoteGirlSexActAndReturn(world, Sex_Anal);
end;
end;
procedure Scene_CantOpen.HandleDisplay;
begin
writeln('Дверь не поддаётся.');
end;
procedure Scene_CantOpen.HandleCommands;
begin
if Command('', 'Отойти.') then world.SwitchTo(Scene_Girl.Create({comeFromFar} false));
end;
procedure Scene_DoorOpeningSound.HandleDisplay;
begin
writeln('Ты слышишь щелчок открывающейся замочной скважины.');
end;
procedure Scene_DoorOpeningSound.HandleCommands;
begin
if Command('', 'Продолжить.') then world.SwitchTo(Scene_Girl.Create({comeFromFar} false));
end;
procedure Scene_DoorEntry.HandleDisplay;
begin
writeln(
'Ты открываешь тяжёлую дверь и ступаешь внутрь. Неширокая пологая лестница ведёт вниз, закругляясь.' + LineEnding +
'Стена слева освещена факелами, горящими странным холодным огнём. Поодаль в стене виднеются двери и ответвления.' + LineEnding +
'Справа от лестницы пропасть. Твои глаза, привыкающие к полутьме, видят далеко на её дне что-то мерцающее в рассеянном свете факелов.' + LineEnding +
'Присмотревшись получше, ты видишь вдалеке над пропастью ряды едва заметных точек — по-видимому, таких же факелов. Похоже, лестница идёт по гигантской спирали.' + LineEnding +
'' + LineEnding +
'Вдруг ты слышишь быстрый, приближающийся звук шагов.' + LineEnding +
'«Я НЕ ДЛЯ ТЕБЯ ЗДЕСЬ ЛЕЖАЛА! Я ЖДАЛА ЧЭДА!»');
end;
procedure Scene_DoorEntry.HandleCommands;
begin
if Command('1', 'Обернуться.') then world.SwitchTo(Scene_GirlRevenge1.Create);
if Command('2', 'Не оборачиваться.') then world.SwitchTo(Scene_GirlRevenge2.Create);
end;
procedure Scene_GirlRevenge1.HandleDisplay;
begin
case stage of
0: writeln(
'Ты решаешься обернуться и твёрдо взглянуть в глаза своей новой суженой.' + LineEnding +
'Она, роняя слёзы, влетает на лестницу и бросает тебе в голову булыжник.' + LineEnding +
'Ты машинально отпрыгиваешь влево — и спиной вниз летишь в пропасть.');
1: writeln(
'Пара секунд невесомости, и ты отключаешься от адской боли.' + LineEnding +
'Очнувшись, ты обнаруживаешь себя насаженным в падении на пару зазубренных пик. По-видимому, именно они и составляли дно пропасти.' + LineEnding +
'К сожалению, на зазубринах осталась часть твоего органокомплекса, и у тебя нет ни единого шанса.' + LineEnding +
'Вдали ты видишь силуэт девушки, один её глаз светится красной точкой.' + LineEnding +
'Ты загипнотизированно смотришь на него и чувствуешь, как кровотечение останавливается. Теперь ты умрёшь ещё не через один час.' + LineEnding +
'' + LineEnding +
'<КОНЕЦ>');
end;
end;
procedure Scene_GirlRevenge1.HandleCommands;
begin
case stage of
0: if Command('', 'Падать...') then inc(stage);
end;
end;
function Scene_GirlRevenge1.HandleFlags: FlagSet;
begin
case stage of
1: result := [Scene_IsEnding];
else result := [];
end;
end;
procedure Scene_GirlRevenge2.HandleDisplay;
begin
writeln(
'Твоя спина холодеет, но ты быстро идёшь вперёд, не оборачиваясь.' + LineEnding +
'После нескольких преодолённых тобой ступенек дверь начинает быстро захлопываться. От неожиданности девушка спотыкается и на всей скорости вмазывается в неё головой.' + LineEnding +
'' + LineEnding +
'Хруст с характерным хлюпанием — звук расколовшегося черепа — последнее, что ты слышишь, прежде чем дверь окончательно захлопывается и сливается со стеной, отрезая тебе путь назад.' + LineEnding +
'Тебе становится грустно. Ты возвращаешься к месту прежней двери, прикладываешь ладонь и долго стоишь молча, вспоминая ваше короткое знакомство.' + LineEnding +
'Встряхнувшись, ты разворачиваешься и решительно шагаешь вниз, в неизвестность.' + LineEnding +
'' + LineEnding +
'<КОНЕЦ>');
end;
function Scene_GirlRevenge2.HandleFlags: FlagSet;
begin
result := [Scene_IsEnding];
end;
{$ifdef demonstrate}
type
TUnicodeStringArray = array of unicodestring;
TArrayOfUnicodeStringArray = array of TUnicodeStringArray;
{$endif}
var
world: TWorld;
cmd: unicodestring;
{$ifdef demonstrate}
scenarios: TArrayOfUnicodeStringArray;
iScenario: SizeInt;
{$endif}
begin
{$ifdef demonstrate}
// сценарии для ideone
scenarios := TArrayOfUnicodeStringArray.Create
(
TUnicodeStringArray.Create('1', '0', ''), // концовка 1
TUnicodeStringArray.Create('1', '1', '', '', '', '1', '', '', '', '1', '', '', '', '', '1', '1', '', ''), // концовка 2
TUnicodeStringArray.Create('1', '1', '', '', '', '1', '', '', '', '1', '', '', '', '', '1', '2', '') // концовка 3
);
for iScenario := 0 to High(scenarios) do
begin
writeln('--- Сценарий ', 1 + iScenario, ' / ', length(scenarios), ' ---');
writeln;
world := TWorld.Create(Scene_Prologue.Create);
try
for cmd in scenarios[iScenario] do
begin
world.Display;
writeln(cmd);
world.SendCommand(cmd);
end;
finally
FreeAndNil(world);
end;
end;
{$else}
// интерактив
world := TWorld.Create(Scene_Prologue.Create);
try
while world.Alive do
begin
world.Display;
readln(cmd);
world.SendCommand(cmd);
end;
finally
FreeAndNil(world);
end;
{$endif}
end.