# ДЕМОНСТРАЦИЯ ИНТЕРПРЕТАТОРА В ПРОГРАММЕ DEMAGOG
# ШУТОЧНЫЙ СКРИПТ ДЛЯ ЭКСПРЕСС-АНАЛИЗА РУССКОЯЗЫЧНОГО ТЕКСТА :)
# ДЛЯ ВЫПОЛНЕНИЯ НАЖМИТЕ F2

str fname, ext, s, tab, t
num i, m, ri, bi, si, li, pri, pbi, psi, pli, nw, stran, N, fsize, emo, mx, m1, m2
str radost  # слова, выражающие положительные эмоции
str borba  # слова, выражающие настроения борьбы
str strah  # слова, выражающие отрицательные эмоции
str love  # слова, выражающие сексуальные отношения
str w  # очередное слово в тексте
str view

radost = 'счаст*|радост*|*радова*|весел*|ликова*|ликую*|смех*|смея*|наслажд*|улыб*|удовольстви*|удоволетвор*|востор*|горд*|мечт*|наград*|награжд*|успех*|успешн*|уверенн*|доверя*|довери*|симпати*|праздн*|парад*|нирван*|экстаз*|талант*|гениальн*|гений|блистат*|восхи*|великолеп*|грандиозн*|потрясающ*|торжеств*|уваж*|умиле*|благодар*|нежн*|самодоволь*|облегчени*|безопасн*|предвкушен*|блажен*|очаровательн*|оживленн*|побед*|сказочн*|головокружительн*|довольн*|возвышенн*|обеспеченн*|угодил*|вдохновлен*'

borba = 'бой*|боев*|битв*|сражени*|войн*|срази*|вождь|выстрел*|стрельб*|перестрел*|драк*|драч*|удар*|побед*|революци*|мятеж*|кампан*|преслед*|решительн*|отваг*|отваж*|бесстраш*|арми*|армей*|дивиз*|флот*|оруди*|полковод*|адмирал*|генерал*|пушечн*|злоб*|злост*|ярост*|оруж*|бомб*|взрыв*|отпор*|храбр*|проворн*|энергичн*|активн*|сил*|резв*|бодр*|мощн*|крепк*' 

strah = 'страх|ужас*|кошмар*|страшн*|смерт*|*мучен*|мучит*|пытк*|допро*|отчаяни*|барак*|надзирател*|лагер*|карцер*|тюрьм*|заключенн*|понос*|баланд*|скелет*|зэк*|шмон*|убил*|убив*|убий*|убить|расстрел*|застрел*|казнь*|казни*|казнен*|казнят|вскрик*|боль|болью|боли|болен|болезн*|умира*|умер*|агони*|слезы*|всхлип*|хрип*|гильотин*|виселиц*|груст*|неприятн*|нездоров*|плакал*|плакать|плач|рыда*|мука|муки|муку|стыд*|задыха*|неуверен*|неудовольств*|недовер*|горе|трево*|тоск*|печаль*|огорч*|обид*|обиж*|бояз*|испуг*|досад*|гнев*|оскорбл*|возмущ*|ненави*|неприяз*|завист*|завиду*|растерянн*|нетерпе*|гореч*|удави*|отребь*|пресыщен*|отвращени*|отвратит*|окровавлен*|жестокос*|экскремент|говн*|мертв*|руга*|обруг*|умоля*|*пощад*|*терз*|самоубийств*|непоправим*|повесил*|повесить*|вешал*|удуш*|*паник*'

love = 'трах*|снош*|поцелу*|клитор*|развра*|распутн*|сперм*|страст*|сладостраст*|влагалищ*|вагин*|хуе*|хуй*|пизд*|еба*|мошонк*|семя*|семени*|ягодиц*|блуд*|дрочи*|мастурб*|содом*|возлюбл*|любов*|флирт*|порочн*|задниц*|фалл*|пенис*|яички*|орги*|анус*|плоть*|матк*|кончил|кончила|кончили|кончив|менстру*|девственн*|потаску*|флагелляц*|эрекц*|гарем*|наложниц*|зачат*|беремен*|заберемен*|совокупл*|целомудр*|член*|лобок|лобк*|похот*|бляд*|проститутк*|грудь|груди'

fname = OpenDialog(0)
if (fname == '')
    exit
fi

fsize = filesize(fname)
m = len(fname)
ext = sub(fname,m-3,4)
ext = lower(ext)

if (ext <> '.txt')
    ShowMessage('Файл должен иметь тип .txt')
    exit
fi

words(fname,'W')
N = W.count 

ri = 0; bi = 0; si = 0; li = 0; nw = 0; tab = chr(9)
t = time(); put 'Начало: ', tab, t
GaugeInit(0,N)
i = 0
do i < N
    i = i+1
    s = see(W.+i)
    w = lower(body(s))
    if (s <> '~E~') & (s <> '~Z~') & (w <> '') 
        nw = nw+1
        if StrMatch(w,radost)
            ri = ri+1
        fi
        if StrMatch(w,borba)
            bi = bi+1
        fi
        if StrMatch(w,strah)
            si = si+1
        fi
        if StrMatch(w,love)
            li = li+1
        fi
        if i % 1000 == 0; Gauge(i); fi;
    fi
od
Gauge(0)
t = time(); put 'Окончание: ', tab, t

put
put 'Файл: ',fname
put

if nw == 0
    ShowMessage('АХАХАХА, пустой файл!')
    put 'Этот файл не содержит слов'
    exit
fi

if (ri == 0) & (bi == 0) & (li == 0) & (si == 0)
    put 'Характер текста: ДОКУМЕНТ'
    put 'Эмоциональность текста - ОТСУТСТВУЕТ'
    exit
fi

stran = floor(nw/250+1)
pri = round(100*ri/nw,3) 
pbi = round(100*bi/nw,3) 
pli = round(100*li/nw,3) 
psi = round(100*si/nw,3) 
emo = (100*ri/nw-0.57)+(100*bi/nw-0.59)+(100*li/nw-0.09)+(100*si/nw-0.66)

put 'Размер файла: ', fsize, ' байт'
put 'Слов в тексте: ', nw,
put ', книжных страниц примерно: ', stran
put
put 'Слов, выражающих...'
put 
put tab, 'положительные эмоции: ',tab, ri, tab,' (',pri,'%   норма - 0.57%)'
put tab, 'настроения борьбы:          ',tab, bi, tab,' (',pbi,'%   норма - 0.59%)'
put tab, 'сексуальные отношения: ',tab, li, tab,' (',pli,'%   норма - 0.09%)'
put tab, 'отрицательные эмоции: ',tab, si, tab,' (',psi,'%   норма - 0.66%)'
put
view = chars('+',ceil(60*ri/(ri+bi+li+si)))+'  радость'; put view
view = chars('+',ceil(60*bi/(ri+bi+li+si)))+'  борьба'; put view
view = chars('+',ceil(60*li/(ri+bi+li+si)))+'  эротика'; put view
view = chars('+',ceil(60*si/(ri+bi+li+si)))+'  трагедия'; put view
put
if emo > 0.05 
    put 'Эмоциональность текста - ПОВЫШЕННАЯ'
fi
if emo < (-0.05)
    put 'Эмоциональность текста - СНИЖЕННАЯ'
fi

put 'Характер текста: ',

if ri < bi; mx = bi; else; mx = ri; fi
if mx < li; mx = li; fi
if mx < si; mx = si; fi
m1 = mx/3
m2 = 2*mx/3

# Если текст попадает сразу в несколько категорий, то они печатаются все, разделенные точкой
# На практике не замечено, чтобы текст удовлетворял более, чем двум категориям
if ri >= bi+li+si
    put 'ОПТИМИСТИЧЕСКИЙ. ',
fi
if bi >= ri+li+si
    put 'АГРЕССИВНЫЙ. ',
fi
if li >= ri+bi+si
    put 'ЭРОТИКА. ',
fi
if si >= ri+bi+li
    put 'ТРАГИЧЕСКИЙ. ',
fi
if (ri >= m2) & (bi >= m2) & (li >= m2) & (si >= m2)
    put 'ОСТРОСЮЖЕТНЫЙ/ЭРОТИЧЕСКИЙ. ',
fi
if (ri >= m2) & (bi >= m2) & (li < m1) & (si  >=  m2)
    put 'ОСТРОСЮЖЕТНЫЙ. ',
fi
if (ri >= bi) & (si-ri < m1) & (bi >= li) & (bi+ri+li >= si) & (si == mx)
    put 'ДРАМАТИЧЕСКИЙ. ',
fi
if (bi >= ri) & (bi >= li) & (bi+ri+li >= si) & (si == mx)
    put 'ГЕРОИЧЕСКИЙ. ',
fi
if (ri >= bi) & (si-ri >= m1) & (bi >= li) & (bi+ri+li >= si) & (si == mx)
    put 'МРАЧНО-ДРАМАТИЧЕСКИЙ. ',
fi
if (bi >= ri) & (si-bi >= m1) & (ri >= li) & (bi+ri+li >= si) & (si == mx) 
    put 'ГЕРОИКО-ДРАМАТИЧЕСКИЙ. ',
fi
if (ri >= bi) & (bi >= si) & (si >= m1) & (ri == mx)
    put 'ЖИЗНЕУТВЕРЖДАЮЩИЙ. ',
fi
if (ri >= si) & (si >= bi) & (bi >= m1) & (li < m1) & (ri >= m2)
    put 'АВАНТЮРНЫЙ. ',
fi
if (ri >= m1) & (ri < m2) & (bi == mx) & (si >= m1) & (si < m2)
    put 'ВОИНСТВЕННЫЙ. ',
fi
if (ri >= m1) & (ri < m2) & (bi == mx) & (si >= m2) & (si < mx)
    put 'БУДОРАЖАЩИЙ. ',
fi
if (ri >= m2) & (bi < m2) & (li == mx) & (si >= m2)
    put 'ЭРОТИКА/САДО-МАЗОХИЗМ. ',
fi
if (ri < m2) & (bi < m2) & (li == mx) & (si >= m2)
    put 'ЭРОТИКА/САДИЗМ. ',
fi
if (ri < m1) & (bi < m1) & (li >= m1) & (si >= m1)
    put 'САДИЗМ. ',
fi
if (ri < m1) & (bi >= m1) & (li >= m1) & (si >= m1)
    put 'НАСИЛИЕ/САДИЗМ. ',
fi
if (ri >= m2) & (bi >= m2) & (li >= m2) & (si < m1)
    put 'НАСИЛИЕ/МАЗОХИЗМ. ',
fi
if (ri == mx) & (bi >= m1) & (li >= m1) & (si >= m2)
    put 'МАЗОХИЗМ. ',
fi
if (ri >=m2) & (bi < m1) & (si >= m1) & (li >=m1) & (li < m2)
    put 'ОПАСНАЯ ЛЮБОВЬ. '
fi
