| ||||
|
На главную
.............. Задачи .............. Финальная статистика .............. Общая статистика .............. Правила .............. 
|
{$IFDEF DLPH}
unit consu;
interface
uses
consu2, SysUtils, Classes;
{$ELSE}
program consu;
{$MODE DELPHI}
{$I-,OBJECTCHECKS-,Q-,R-,S-}
uses
SysUtils, Classes;
{$ENDIF}
type
TPoint = record
x,y : integer;
end;
TRect=record
left,top,right,bottom: integer;
end;
TFPoint = record
x,y : double;
end;
// ********* INSERT CONSU2 CONSTANTS HERE!!!
// ********* BEGIN OF CONSTANTS HERE!
var
ss : array[0..1831] of string[36] = (
'jhj',
'jhj',
'iji',
'iji',
'iebei',
'hfbfh',
'hfbfh',
'hedeh',
'gfdfg',
'gfdfg',
'fffff',
'fffff',
'fffff',
'efhfe',
'efhfe',
'efhfe',
'dtd',
'dtd',
'dtd',
'cvc',
'cflfc',
'cflfc',
'bfnfb',
'bfnfb',
'bfnfb',
'afpf',
'aqf',
'asd',
'atc',
'atc',
'afjgb',
'afkfb',
'afkfb',
'afkfb',
'afkfb',
'afjfc',
'asd',
'are',
'asd',
'atc',
'afjgb',
'afkg',
'aflf',
'aflf',
'aflf',
'aflf',
'afkg',
'afjgb',
'aub',
'atc',
'asd',
'aqf',
'iig',
'gme',
'epd',
'drc',
'chfhb',
'cfjfb',
'bfkg',
'bfldc',
'bfq',
'afr',
'afr',
'afr',
'afr',
'afr',
'afr',
'afr',
'afr',
'bflbe',
'bfleb',
'bfkg',
'cfigb',
'chfhb',
'drc',
'epd',
'gme',
'ihh',
'aoh',
'aqf',
'are',
'asd',
'afhhc',
'afjgb',
'afkfb',
'afkfb',
'aflf',
'aflf',
'aflf',
'aflf',
'aflf',
'aflf',
'aflf',
'aflf',
'aflf',
'aflf',
'afkfb',
'afkfb',
'afjgb',
'afigc',
'asd',
'are',
'aqf',
'aoh',
'asb',
'asb',
'asb',
'asb',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'arc',
'arc',
'arc',
'arc',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'at',
'at',
'at',
'at',
'ar',
'ar',
'ar',
'ar',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'apc',
'apc',
'apc',
'apc',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'afm',
'jih',
'goe',
'fqd',
'esc',
'dhghb',
'cgjh',
'bglg',
'bfndc',
'bfs',
'aft',
'aft',
'aft',
'afil',
'afil',
'afil',
'afil',
'afof',
'bfnf',
'bfnf',
'bgmf',
'cgkg',
'dhgi',
'eu',
'frc',
'goe',
'jih',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'au',
'au',
'au',
'au',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'af',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'lf',
'cdgf',
'afgf',
'afgf',
'agff',
'bfefb',
'bob',
'cmc',
'dkd',
'ehf',
'afkgb',
'afjgc',
'afigd',
'afhge',
'afggf',
'affhf',
'afehg',
'afdhh',
'afchi',
'afcgj',
'afbhj',
'anj',
'aoi',
'aph',
'aicfh',
'aicgg',
'ahefg',
'agfgf',
'afhge',
'afife',
'afigd',
'afjgc',
'afkfc',
'afkgb',
'aflg',
'aflg',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'afn',
'as',
'as',
'as',
'as',
'ahjh',
'ahjh',
'aihi',
'aihi',
'aihi',
'aihi',
'aebefebe',
'aebefebe',
'aebefebe',
'aecdfdce',
'aecdfdce',
'aecedece',
'aecedece',
'aeddddde',
'aeddddde',
'aedebede',
'aedebede',
'aeedbdee',
'aeedbdee',
'aeedbdee',
'aeehee',
'aefffe',
'aefffe',
'aefffe',
'aegdge',
'aegdge',
'agke',
'agke',
'ahje',
'ahje',
'aiie',
'aiie',
'ajhe',
'aebehe',
'aebfge',
'aecege',
'aecffe',
'aedefe',
'aedfee',
'aeeeee',
'aeefde',
'aefede',
'aeffce',
'aegece',
'aegfbe',
'aehebe',
'aehj',
'aeii',
'aeii',
'aejh',
'aejh',
'aekg',
'iii',
'gmg',
'eqe',
'dsd',
'chghc',
'cgigc',
'bgkgb',
'bfmfb',
'bfmfb',
'afof',
'afof',
'afof',
'afof',
'afof',
'afof',
'afof',
'afof',
'bfmfb',
'bfmfb',
'bgkgb',
'cgigc',
'chghc',
'dsd',
'eqe',
'gmg',
'iii',
'aof',
'aqd',
'arc',
'asb',
'afhgb',
'afig',
'afjf',
'afjf',
'afjf',
'afjf',
'afig',
'afhgb',
'asb',
'arc',
'aqd',
'aof',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'afo',
'iij',
'gmh',
'eqf',
'dse',
'chghd',
'cgigd',
'bgkgc',
'bfmfc',
'bfmgb',
'afofb',
'afofb',
'afofb',
'afofb',
'afofb',
'afofb',
'afofb',
'afofb',
'bfgcefc',
'bfgddfc',
'bgemc',
'cgekd',
'chfhe',
'dtd',
'eub',
'gt',
'iidfb',
'ueb',
'wbc',
'aqh',
'asf',
'ate',
'aud',
'afjhc',
'aflfc',
'aflfc',
'aflfc',
'aflfc',
'afkgc',
'afjgd',
'aud',
'ate',
'arg',
'api',
'afehh',
'afggg',
'afhgf',
'afhgf',
'afige',
'afjgd',
'afjgd',
'afkgc',
'aflfc',
'aflgb',
'afmg',
'gih',
'ene',
'dpd',
'crc',
'cgfgc',
'bfigb',
'bfjfb',
'bfjfb',
'bgo',
'bjl',
'cli',
'dnf',
'eod',
'gnc',
'jlb',
'ni',
'pg',
'cdlf',
'aflf',
'agkf',
'bgig',
'bhggb',
'csb',
'dqc',
'ene',
'gjg',
'av',
'av',
'av',
'av',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'afkf',
'agjf',
'bfifb',
'bhfgb',
'crb',
'cqc',
'end',
'gig',
'afpf',
'bfnfb',
'bfnfb',
'bfnfb',
'cflfc',
'cflfc',
'cfkgc',
'dfjfd',
'dfjfd',
'efhfe',
'efhfe',
'efhfe',
'fffff',
'fffff',
'gefff',
'gfdfg',
'gfdfg',
'hedeh',
'hfbfh',
'hfbfh',
'iebei',
'iji',
'jhj',
'jhj',
'jhj',
'kfk',
'afkfkf',
'afkfkf',
'bfihifb',
'bfihifb',
'bfihifb',
'bfihifb',
'cfgebegfc',
'cfgebegfc',
'cfgebegfc',
'cffeddgfc',
'defedefed',
'dfeedeefd',
'dfedfdefd',
'dfdefedfd',
'eedefedee',
'efcefedee',
'efbehdcfe',
'efbehebfe',
'febehebfe',
'febdjdbef',
'fijif',
'fijif',
'gglhf',
'gglgg',
'gglgg',
'gglgg',
'bgigb',
'bgigb',
'cgggc',
'dgegd',
'dgegd',
'egcge',
'ffcff',
'fmf',
'gkg',
'gkg',
'hih',
'igi',
'igi',
'hih',
'hih',
'gkg',
'fmf',
'fmf',
'egcge',
'efefe',
'dgegd',
'cgggc',
'cgggc',
'bgigb',
'agkg',
'agkg',
'aglg',
'aglg',
'bgjgb',
'cfjfc',
'cghgc',
'dfhfd',
'efffe',
'egdge',
'ffdff',
'fgbgf',
'gfbfg',
'hjh',
'hjh',
'ihi',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'jfj',
'csb',
'csb',
'csb',
'csb',
'ogb',
'ngc',
'mgd',
'mfe',
'lff',
'kgf',
'jgg',
'igh',
'ifi',
'hfj',
'gfk',
'fgk',
'egl',
'efm',
'dfn',
'cfo',
'bgo',
'agp',
'av',
'av',
'av',
'av',
'ehi',
'ehi',
'idi',
'idi',
'gdbdg',
'gdbdg',
'gdbdg',
'gdbdg',
'edfde',
'edfde',
'edfde',
'edfde',
'ele',
'ele',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'ahfh',
'ahfh',
'anc',
'anc',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'clc',
'clc',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'anc',
'anc',
'ehbd',
'ehbd',
'cdff',
'cdff',
'adjd',
'adjd',
'adjd',
'adjd',
'adm',
'adm',
'adm',
'adm',
'adm',
'adm',
'adm',
'adm',
'cdhd',
'cdhd',
'ejc',
'ejc',
'ale',
'ale',
'cdfdc',
'cdfdc',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdfdc',
'cdfdc',
'ale',
'ale',
'ap',
'ap',
'cdhd',
'cdhd',
'cdk',
'cdk',
'cddde',
'cddde',
'cje',
'cje',
'cddde',
'cddde',
'cdk',
'cdk',
'cdk',
'cdk',
'cdhd',
'cdhd',
'ap',
'ap',
'ap',
'ap',
'cdhd',
'cdhd',
'cdk',
'cdk',
'cddde',
'cddde',
'cje',
'cje',
'cddde',
'cddde',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'ajg',
'ajg',
'ehbdc',
'ehbdc',
'cdffc',
'cdffc',
'adjdc',
'adjdc',
'adjdc',
'adjdc',
'ado',
'ado',
'adfj',
'adfj',
'adjdc',
'adjdc',
'adjdc',
'adjdc',
'cdhdc',
'cdhdc',
'eje',
'eje',
'ahfh',
'ahfh',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cpc',
'cpc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'ahfh',
'ahfh',
'al',
'al',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'ede',
'al',
'al',
'gl',
'gl',
'kde',
'kde',
'kde',
'kde',
'kde',
'kde',
'kde',
'kde',
'kde',
'kde',
'kde',
'kde',
'adhde',
'adhde',
'adhde',
'adhde',
'cjg',
'cjg',
'ahbhc',
'ahbhc',
'cdfde',
'cdfde',
'cdddg',
'cdddg',
'cdddg',
'cdddg',
'cdbdi',
'cdbdi',
'chi',
'chi',
'cdddg',
'cdddg',
'cdfde',
'cdfde',
'cdhdc',
'cdhdc',
'ahff',
'ahff',
'ajg',
'ajg',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdhd',
'cdhd',
'ap',
'ap',
'afjf',
'afjf',
'cdjdc',
'cdjdc',
'cfffc',
'cfffc',
'cfffc',
'cfffc',
'cdbdbdbdc',
'cdbdbdbdc',
'cdbdbdbdc',
'cdbdbdbdc',
'cdddddc',
'cdddddc',
'cdddddc',
'cdddddc',
'cdjdc',
'cdjdc',
'ahfh',
'ahfh',
'affj',
'affj',
'cdjdc',
'cdjdc',
'cfhdc',
'cfhdc',
'cdbdfdc',
'cdbdfdc',
'cdbdfdc',
'cdbdfdc',
'cdddddc',
'cdddddc',
'cdfdbdc',
'cdfdbdc',
'cdfdbdc',
'cdfdbdc',
'cdhfc',
'cdhfc',
'ajfdc',
'ajfdc',
'ehe',
'ehe',
'cdfdc',
'cdfdc',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'cdfdc',
'cdfdc',
'ehe',
'ehe',
'anc',
'anc',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'cdhd',
'clc',
'clc',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'cdk',
'ajg',
'ajg',
'ehe',
'ehe',
'cdfdc',
'cdfdc',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'adjd',
'cdfdc',
'cdfdc',
'ehe',
'ehe',
'gfe',
'gfe',
'cfdf',
'cfdf',
'ane',
'ane',
'cdhdc',
'cdhdc',
'cdhdc',
'cdhdc',
'cdhdc',
'cdhdc',
'cdhdc',
'cdhdc',
'cle',
'cle',
'cdddg',
'cdddg',
'cdfde',
'cdfde',
'cdhdc',
'cdhdc',
'ahff',
'ahff',
'cjbd',
'cjbd',
'adhf',
'adhf',
'adjd',
'adjd',
'adm',
'adm',
'chg',
'chg',
'ifc',
'ifc',
'md',
'md',
'adjd',
'adjd',
'afhd',
'afhd',
'adbjc',
'adbjc',
'at',
'at',
'adfdfd',
'adfdfd',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'ele',
'ele',
'ahfh',
'ahfh',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'cfffc',
'cfffc',
'ghg',
'ghg',
'ahfh',
'ahfh',
'cdjdc',
'cdjdc',
'cdjdc',
'cdjdc',
'edfde',
'edfde',
'edfde',
'edfde',
'edfde',
'edfde',
'gdbdg',
'gdbdg',
'gdbdg',
'gdbdg',
'idi',
'idi',
'idi',
'idi',
'afjf',
'afjf',
'adnd',
'adnd',
'adfdfd',
'adfdfd',
'adfdfd',
'adfdfd',
'cdbdbdbdc',
'cdbdbdbdc',
'cdbdbdbdc',
'cdbdbdbdc',
'cdbdbdbdc',
'cdbdbdbdc',
'edfde',
'edfde',
'edfde',
'edfde',
'edfde',
'edfde',
'ahfh',
'ahfh',
'cdjdc',
'cdjdc',
'edfde',
'edfde',
'gdbdg',
'gdbdg',
'idi',
'idi',
'idi',
'idi',
'gdbdg',
'gdbdg',
'edfde',
'edfde',
'cdjdc',
'cdjdc',
'ahfh',
'ahfh',
'ahfh',
'ahfh',
'cdjdc',
'cdjdc',
'edfde',
'edfde',
'edfde',
'edfde',
'gdbdg',
'gdbdg',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'idi',
'ele',
'ele',
'ap',
'ap',
'adjd',
'adjd',
'kdc',
'kdc',
'ide',
'ide',
'gdg',
'gdg',
'gdg',
'gdg',
'edi',
'edi',
'cdk',
'cdk',
'adjd',
'adjd',
'ap',
'ap',
'mbm',
'mcl',
'ldl',
'lek',
'kfk',
'kgj',
'jbbfj',
'jbbfj',
'jbbgi',
'ibdfi',
'ibdgh',
'hbffh',
'hbffh',
'hbfgg',
'gbhfg',
'gbhgf',
'fbjff',
'fpf',
'eblfe',
'eblfe',
'dclgd',
'dbnfd',
'cdmgc',
'aigl',
'arf',
'cgfgd',
'dfhfc',
'dfhfc',
'dfifb',
'dfifb',
'dfifb',
'dfifb',
'dfhfc',
'dfggc',
'dfege',
'dof',
'dffgd',
'dfhfc',
'dfhgb',
'dfig',
'dfig',
'dfig',
'dfig',
'dfig',
'dfhgb',
'dfggc',
'chegd',
'aqg',
'jifb',
'hegccc',
'ffje',
'efld',
'dfnc',
'cfoc',
'cfpb',
'bgpb',
'bfr',
'agr',
'agr',
'agr',
'agr',
'agr',
'agr',
'agr',
'bgq',
'bgq',
'cfq',
'cgnbb',
'dfmcb',
'efkcc',
'gfgce',
'jig',
'aqi',
'cgffg',
'dfhfe',
'dfifd',
'dfigc',
'dfjfc',
'dfjgb',
'dfjgb',
'dfkg',
'dfkg',
'dfkg',
'dfkg',
'dfkg',
'dfkg',
'dfkg',
'dfkg',
'dfkfb',
'dfjgb',
'dfjfc',
'dfjfc',
'dfifd',
'dfhfe',
'cgffg',
'apj',
'atb',
'cgheb',
'dfidb',
'dfjcb',
'dfjcb',
'dffbebb',
'dffbebb',
'dffbg',
'dfecg',
'dfecg',
'dfddg',
'dlg',
'dfddg',
'dfecg',
'dfecg',
'dffbg',
'dffbg',
'dffbfb',
'dflb',
'dfkc',
'dfkbb',
'dfjcb',
'chgeb',
'atb',
'au',
'cghf',
'dfjd',
'dfkc',
'dfkc',
'dflb',
'dfgbeb',
'dfgbf',
'dfgbf',
'dffcf',
'dffcf',
'dfdef',
'dmf',
'dfdef',
'dffcf',
'dffcf',
'dfgbf',
'dfgbf',
'dfgbf',
'dfm',
'dfm',
'dfm',
'chl',
'alj',
'jifbd',
'gffdccd',
'fejfd',
'eeled',
'dfmdd',
'cfocd',
'bgocd',
'bgpbd',
'bfu',
'agu',
'agu',
'agu',
'agu',
'agu',
'agjl',
'aglhc',
'bfmfd',
'bglfd',
'cflfd',
'delfd',
'eekfd',
'fejfd',
'gfgfe',
'jkh',
'alel',
'chihc',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dud',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'dfkfd',
'chihc',
'alel',
'al',
'chc',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'dfd',
'chc',
'al',
'gm',
'jhc',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'kfd',
'bdgfd',
'afffd',
'afffd',
'afffd',
'aegee',
'bdgee',
'cdedg',
'egi',
'algjb',
'chkfd',
'dfmcf',
'dflcg',
'dfkbi',
'dfjbj',
'dfibk',
'dfgcl',
'dffbn',
'dfebo',
'dfcdo',
'dfbfn',
'dmm',
'dfcgl',
'dfchk',
'dfdhj',
'dfegj',
'dffgi',
'dfggh',
'dfhgg',
'dfhhf',
'dfihe',
'chhid',
'aldn',
'alk',
'chm',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfmb',
'dfmb',
'dflc',
'dflc',
'dfkcb',
'dfjdb',
'cgieb',
'aub',
'ajpi',
'chohc',
'dgogd',
'dhmbbfd',
'dbbfmbbfd',
'dbbglbbfd',
'dbbgkbcfd',
'dbcfkbcfd',
'dbcgibdfd',
'dbdfibdfd',
'dbdggbefd',
'dbefgbefd',
'dbeffbffd',
'dbegebffd',
'dbffdbgfd',
'dbfgcbgfd',
'dbgfbbhfd',
'dbgfbbhfd',
'dbggifd',
'dbhfifd',
'dbhejfd',
'dbidjfd',
'cdhcjhc',
'ahgbhl',
'aijh',
'dgkdc',
'dhkbd',
'dijbd',
'dbbgjbd',
'dbcgibd',
'dbdghbd',
'dbeggbd',
'dbeggbd',
'dbfgfbd',
'dbggebd',
'dbhgdbd',
'dbigcbd',
'dbigcbd',
'dbjgbbd',
'dbkhd',
'dblgd',
'dblgd',
'dbmfd',
'dbned',
'dbodd',
'dbpcd',
'cdocd',
'ahnbd',
'iji',
'gefeg',
'efhfe',
'dfjfd',
'cflfc',
'cflfc',
'bglgb',
'bfnfb',
'agng',
'agng',
'agng',
'agng',
'agng',
'agng',
'agng',
'agnfb',
'bfnfb',
'bglgb',
'cflfc',
'deled',
'dfjfd',
'fehef',
'gefeg',
'jhj',
'aqf',
'cgffd',
'dfgfc',
'dfhfb',
'dfif',
'dfif',
'dfif',
'dfif',
'dfif',
'dfhfb',
'dfgfc',
'dfffd',
'dmg',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'dfn',
'chm',
'alk',
'jhj',
'gefeg',
'fehef',
'dfjfd',
'deled',
'cflfc',
'bglgb',
'bfnfb',
'agng',
'agng',
'agng',
'agng',
'agng',
'agng',
'agng',
'agng',
'bfnfb',
'bglgb',
'cflfc',
'cflfc',
'dfjfd',
'efhfe',
'gefff',
'ikh',
'kgj',
'kgj',
'lgi',
'mgh',
'nhf',
'qib',
'ari',
'cggfg',
'dfief',
'dfife',
'dfjfd',
'dfjfd',
'dfjfd',
'dfjfd',
'dfjfd',
'dfife',
'dfife',
'dfggf',
'dph',
'dfcgj',
'dfdgi',
'dfegh',
'dffgg',
'dfggf',
'dfggf',
'dfhge',
'dfigd',
'dfjgc',
'chjgb',
'alhh',
'fffbb',
'ddecdbb',
'cdheb',
'bdjdb',
'aekcb',
'aekcb',
'afkbb',
'ahibb',
'aji',
'bkg',
'cle',
'dld',
'elc',
'gkb',
'ij',
'abjh',
'abkg',
'ackf',
'acle',
'adkdb',
'aejdb',
'afhdc',
'acccfdd',
'abfgf',
'av',
'adffee',
'acgfgc',
'acgfgc',
'abhfhb',
'abhfhb',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'ifi',
'hhh',
'flf',
'algh',
'cgldc',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'dfmbd',
'eelbe',
'efkbe',
'fejbf',
'gffcg',
'iii',
'algi',
'chldc',
'dglcd',
'dglcd',
'eflbe',
'egjbf',
'ffjbf',
'fgibf',
'gfhbg',
'gfhbg',
'ggfbh',
'hffbh',
'hgdbi',
'ifdbi',
'ifdbi',
'igbbj',
'jfbbj',
'jgk',
'kfk',
'kfk',
'kel',
'ldl',
'lcm',
'mbm',
'akdlfg',
'cghhjdb',
'dfifkcc',
'dfigjbd',
'efifjbd',
'efighbe',
'eghghbe',
'ffhghbe',
'ffhhfbf',
'fgfbcffbf',
'gffbcffbf',
'gffbcgdbg',
'hfdbefdbg',
'hfdbefdbg',
'hgbbgfbbh',
'ifbbgfbbh',
'ifbbggi',
'igifi',
'jfifi',
'jejej',
'jekdj',
'kdkdj',
'kclck',
'lbmbk',
'blej',
'ciied',
'dgkce',
'egjbf',
'ffibg',
'fggbh',
'ggebi',
'hgdbi',
'hgcbj',
'ihk',
'jgk',
'jgk',
'kgj',
'lgi',
'kbbfi',
'jbcgh',
'ibegg',
'hbgfg',
'gbhgf',
'fcige',
'fbkgd',
'eckgd',
'cekib',
'ajfl',
'akhh',
'cgldc',
'cgmbd',
'dgkbe',
'efkbe',
'egibf',
'ffhbg',
'fggbg',
'gffbh',
'ggebh',
'hfdbi',
'hgcbi',
'ifbbj',
'igk',
'jfk',
'jfk',
'jfk',
'jfk',
'jfk',
'jfk',
'jfk',
'jfk',
'jfk',
'glh',
'dtb',
'deigc',
'ddjfd',
'cckgd',
'ccjge',
'cbkff',
'cbjgf',
'lgg',
'lfh',
'kfi',
'jgi',
'jfj',
'ifk',
'hgk',
'hfl',
'gflb',
'fglb',
'eglc',
'efmc',
'dgld',
'cgldb',
'cfleb',
'bgjgb',
'awb'
);
sh : array[0..77] of integer = (
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
26, 26, 26, 26, 28, 26, 26, 26, 26, 26, 26, 26,
26, 26, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
20, 20, 20, 20, 20, 20, 24, 20, 20, 20, 20, 20,
20, 20, 20, 20, 24, 24, 24, 24, 24, 24, 24, 24,
24, 24, 24, 24, 24, 24, 24, 24, 30, 24, 24, 24,
24, 24, 24, 24, 24, 24
);
sw : array[0..77] of integer = (
25, 21, 22, 21, 19, 17, 24, 20, 5, 16, 22, 18, 23,
20, 24, 19, 25, 23, 21, 21, 20, 25, 35, 22, 23,
21, 19, 15, 15, 15, 15, 15, 17, 19, 11, 17, 17,
15, 19, 19, 15, 15, 15, 17, 15, 19, 19, 19, 19,
19, 19, 15, 25, 22, 23, 24, 20, 20, 26, 26, 11,
18, 27, 21, 32, 24, 25, 21, 25, 25, 17, 21, 24,
25, 35, 25, 24, 24
);
sp : array[0..77] of integer = (
0, 26, 52, 78, 104, 130, 156, 182, 208, 234, 260,
286, 312, 338, 364, 390, 416, 444, 470, 496, 522,
548, 574, 600, 626, 652, 678, 698, 718, 738, 758,
778, 798, 818, 838, 858, 878, 898, 918, 938, 958,
978, 998, 1022, 1042, 1062, 1082, 1102, 1122, 1142,
1162, 1182, 1202, 1226, 1250, 1274, 1298, 1322,
1346, 1370, 1394, 1418, 1442, 1466, 1490, 1514,
1538, 1562, 1586, 1616, 1640, 1664, 1688, 1712,
1736, 1760, 1784, 1808
);
Const
sc='ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ';
num=78;
sslen=1832;
// ********* END OF CONSTANTS HERE!
// ********* INSERT CONSU2 CONSTANTS HERE!!!
var
// A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
links: array[0..25] of integer = (1,2,0,1,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0);
l : array[1..200] of string[200];
w,h: integer; // после поворота - размер области с текстом
t : array[1..200] of string[200]; // используется для временных нужд
// L-field
p1,p2,p3,p4 : TPoint;
pb: boolean;
base1, base2: TPoint;
// fill
fc: integer;
fx,fy : array[1..100] of integer;
smb: array[1..100] of TRect; // char-fields
smbn: integer;
smax: double;
{$IFDEF DLPH}
procedure runmain;
function findstr:string; // L-to-str
procedure FindRect;
procedure ImproveRect;
procedure rotateRect;
procedure deholing;
procedure findsymbols;
function gett(n,x,y: integer):char;
procedure sortsymbols;
function setp(x,y: integer; b: boolean):boolean;
function get(x,y: integer):boolean;
procedure Denoise;
function recsymbol(r: TRect):char;
function compressline(s: string):string;
procedure decfonts;
implementation
{$ENDIF}
procedure swappoint(var a,b: TPoint);
var t: TPoint;
begin
t := a; a := b; b := t;
end;
function max(a,b: integer):integer;
begin
if a>=b then
result := a
else
result := b;
end;
function min(a,b: integer):integer;
begin
if a<=b then
result := a
else
result := b;
end;
function sign(n: integer):integer;
begin
if n>0 then result := 1 else
if n<0 then result := -1 else
result := 0;
end;
function get(x,y: integer):boolean;
begin
if (x < 1) or (x > 200) or (y < 1) or (y > 200) then
result := false
else
result := l[y][x]<>'.';
end;
function setp(x,y: integer; b: boolean):boolean;
begin
result := false;
if (x < 1) or (x > 200) or (y < 1) or (y > 200) then
exit;
result := true;
if b then
l[y][x] := 'X'
else
l[y][x] := '.';
end;
function GetField(x,y: integer; maxdepth: integer):integer;
begin
result := 0;
if (x < 1) or (x > 200) or (y < 1) or (y > 200) then
exit;
if l[y][x]<>'X' then
exit;
inc(fc);
fx[fc] := x;
fy[fc] := y;
l[y][x] := '*';
inc(result);
if result >= maxdepth then exit;
result := result + GetField(x-1,y, maxdepth-1);
if result >= maxdepth then exit;
result := result + GetField(x+1,y, maxdepth-1);
if result >= maxdepth then exit;
result := result + GetField(x,y-1, maxdepth-1);
if result >= maxdepth then exit;
result := result + GetField(x,y+1, maxdepth-1);
end;
procedure RemoveField;
var i: integer;
begin
for i := 1 to fc do
setp(fx[i], fy[i], false);
end;
procedure ResetField; // вернуть X вместо *
var i: integer;
begin
for i := 1 to fc do
setp(fx[i], fy[i], true);
end;
procedure Denoise;
var
x,y,i,n: integer;
begin
for y := 1 to 200 do
for x := 1 to 200 do
if get(x,y) then
begin
n := 0;
if get(x-1,y) then inc(n);
if get(x+1,y) then inc(n);
if get(x,y-1) then inc(n);
if get(x,y+1) then inc(n);
if n < 2 then
l[y][x] := '*';
end;
for y := 1 to 200 do
for x := 1 to 200 do
if l[y][x]='*' then
l[y][x]:='.';
for y := 1 to 200 do
for x := 1 to 200 do
if get(x,y) then
begin
fc := 0;
i := getfield(x,y,10); // get length of field (max depth = 10)
if i < 10 then
removefield
else
resetfield;
end;
end;
function len2(const a,b: TPoint):integer;
begin
result := (a.X-b.x)*(a.X-b.x) + (a.y-b.y)*(a.y-b.y);
end;
procedure rotate(var x,y: integer; xc,yc: integer; angle: double);
var tx,ty: integer;
begin
tx := x-xc;
ty := y-yc;
x := xc + round( tx*cos(angle) - ty*sin(angle) );
y := yc + round( tx*sin(angle) + ty*cos(angle) );
end;
procedure rotateline(var a,b: TPoint; angle: double);
var
xc,yc: integer;
begin
xc := (a.x + b.x) div 2;
yc := (a.y + b.y) div 2;
rotate(a.x, a.y, xc,yc, angle);
rotate(b.x, b.y, xc,yc, angle);
end;
// move to normal (-H - back dire)
procedure MoveToN(var a,b: TPoint; h: integer);
var
x,y: integer;
k,xn,yn: double;
begin
if h=0 then exit;
x := b.x-a.X;
y := b.y-a.y;
xn := x*cos(-pi/2) - y*sin(-pi/2);
yn := x*sin(-pi/2) + y*cos(-pi/2);
k := h/sqrt(xn*xn+yn*yn);
xn := xn*k;
yn := yn*k;
a.x := round(a.x + xn);
a.y := round(a.y + yn);
b.x := round(b.x + xn);
b.y := round(b.y + yn);
end;
// number of points for line
function linew(const a,b: TPoint):integer;
var
i, x,y, d,xerr, yerr,dx,dy,incx,incy: integer;
begin
xerr := 0;
yerr := 0;
dx := b.x-a.x;
dy := b.y-a.y;
incx := sign(b.x-a.x);
incy := sign(b.y-a.y);
dx := abs(dx);
dy := abs(dy);
d := max(dx,dy);
x := a.x;
y := a.y;
result := 0;
for i := 0 to d do
begin
if get(x,y) then
inc(result);
inc(xerr,dx);
inc(yerr,dy);
if xerr>=d then
begin
dec(xerr,d);
inc(x,incx);
end;
if yerr>=d then
begin
dec(yerr,d);
inc(y,incy);
end;
end;
end;
// по контрасту - "хорошая" граница при паралл-м перем-ии резко входит в контакт с точками (и выходит из него) }
function lineq(const a,b: TPoint):integer;
var
w1,w2,i: integer;
c,d: TPoint;
begin
result := 0; // максимальный "контраст" (разница в весе линий) при параллельном перемешении
w2 := 0;
for i := -4 to 4 do
begin
c := a;
d := b;
moveton(c,d, i);
w1 := w2;
w2 := linew(c,d);
if i<>-4 then
result := max(result, abs(w1-w2));
end;
end;
procedure FindRect;
var
x,y,i: integer;
a1,a2,b1,b2 : TPoint;
begin
// top line
i := 0;
for y := 1 to 200 do
if i>0 then break else
for x := 200 downto 1 do
if get(x, y) then
begin
p1.X := x;
p1.Y := y;
i := 1;
break;
end;
// right line
i := 0;
for x := 200 downto 1 do
if i>0 then break else
for y := 1 to 200 do
if get(x, y) then
begin
p2.X := x;
p2.Y := y;
i := 1;
break;
end;
// bottom line
i := 0;
for y := 200 downto 1 do
if i>0 then break else
for x := 1 to 200 do
if get(x, y) then
begin
p3.X := x;
p3.Y := y;
i := 1;
break;
end;
// left line
i := 0;
for x := 1 to 200 do
if i>0 then break else
for y := 200 downto 1 do
if get(x, y) then
begin
p4.X := x;
p4.Y := y;
i := 1;
break;
end;
if p2.X-p1.X>p1.X-p4.x then // больше справа
begin
a1 := p1;
a2 := p2;
moveton(a1,a2, 3);
a2.x := p2.x;
a2.Y := a1.Y;
end
else
begin // больше слева
a1 := p1;
a2 := p4;
moveton(a1,a2, -3);
a2.x := p4.x;
a2.y := a1.y;
end;
while linew(a1,a2) = 0 do
inc(a2.Y);
dec(a2.Y);
if p2.X-p3.X>p3.X-p4.x then // больше справа
begin
b1 := p3;
b2 := p2;
moveton(b1,b2, -3);
b2.x := p2.x;
b2.Y := b1.Y;
end
else
begin // больше слева
b1 := p3;
b2 := p4;
moveton(b1,b2, 3);
b2.x := p4.x;
b2.y := b1.y;
end;
while linew(b1,b2) = 0 do
dec(b2.Y);
inc(b2.Y);
if a2.X > a1.X then
swappoint(a1,a2);
p1 := a1;
p2 := a2;
if b2.X < b1.X then
swappoint(b1,b2);
p3 := b1;
p4 := b2;
pb := true;
if (len2(p1,p2)>len2(p2,p3)) and (len2(p1,p2)>len2(p4,p1)) or
(len2(p3,p3)>len2(p2,p3)) and (len2(p3,p4)>len2(p4,p1)) then
// width: p1-p2/p3-p4 (height:p2-p3/p4-p1)
if lineq(p1,p2) > lineq(p3,p4) then
begin
base1 := p1;
base2 := p2;
end else begin
base1 := p3;
base2 := p4;
end
else // width: p4-p1/p2-p3 (height: p1-p2/p3-p4)
if lineq(p2,p3) > lineq(p4,p1) then
begin
base1 := p2;
base2 := p3;
end else begin
base1 := p4;
base2 := p1;
end
end;
procedure ImproveRect;
var
i,j: integer;
a,b: TPoint;
begin
for i:=0 to 10 do // shift to notmal dir (both directions)
begin
a := base1;
b := base2;
movetoN(a,b, i);
if linew(a,b)=0 then
begin
base1 := a;
base2 := b;
break;
end;
a := base1;
b := base2;
movetoN(a,b, -i);
if linew(a,b)=0 then
begin
base1 := a;
base2 := b;
break;
end;
end;
// find another boundary
p1 := base1;
p2 := base2;
a := base1;
b := base2;
moveton(a,b, 3);
if linew(a,b) > 0 then
i := 3
else
i := -3;
repeat
if i>0 then inc(i) else dec(i);
a := base1;
b := base2;
moveton(a,b, i);
until linew(a,b) = 0;
p3 := b;
p4 := a;
// move high-lines
i := 0;
repeat
a := p4;
b := p1;
moveton(a,b, i);
if linew(a,b) = 0 then
begin
if i>=0 then j := i + 5 else j := i -5;
a := p4;
b := p1;
moveton(a,b, j);
if linew(a,b) = 0 then
break;
end;
i := -i;
if i>=0 then inc(i);
until false;
moveton(p4,p1, i);
i := 0;
repeat
a := p2;
b := p3;
moveton(a,b, i);
if linew(a,b) = 0 then
begin
if i>=0 then j := i + 5 else j := i -5;
a := p2;
b := p3;
moveton(a,b, j);
if linew(a,b) = 0 then
break;
end;
i := -i;
if i>=0 then inc(i);
until false;
moveton(p2,p3, i);
if p1.X > p2.X then
begin
swappoint(p1,p2);
swappoint(p3,p4);
end;
if p1.y > p4.y then
begin
swappoint(p1,p4);
swappoint(p2,p3);
end;
end;
procedure GetSrcPoint(x,y: integer; w,h: integer; var dx,dy: double);
var
a1,a2 : TFPoint;
begin
dec(x); dec(y);
a1.x := p1.x+(p2.x-p1.x)*x/w;
a1.y := p1.y+(p2.y-p1.y)*x/w;
a2.x := p4.x+(p3.x-p4.x)*x/w;
a2.y := p4.y+(p3.y-p4.y)*x/w;
dx := a1.x+(a2.x-a1.x)*y/h;
dy := a1.y+(a2.y-a1.y)*y/h;
end;
// getpixel (interpolated)
function getInt(x,y: double):double;
var
i,j : integer;
fx,fy : double;
begin
result := 0;
i := trunc(x);
j := trunc(y);
fx := frac(x);
fy := frac(y);
if get(i, j) then
result := result + (1-fx)+(1-fy);
if get(i+1, j) then
result := result + fx+(1-fy);
if get(i+1, j+1) then
result := result + fx+fy;
if get(i, j+1) then
result := result + (1-fx)+fy;
result := result / 2;
end;
procedure rotateRect;
var
x,y: integer;
i,j: double;
begin
for y := 1 to 200 do
t[y] := stringofchar('.',200);
// align rect
w := round (sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y)) );
h := round (sqrt(sqr(p1.x-p4.x)+sqr(p1.y-p4.y)) );
for y := 1 to h do
for x := 1 to w do
begin
GetSrcPoint(x,y, w,h, i,j);
if getint(i,j) >= 0.95 then
t[y][x] := 'X';
end;
for y := 1 to 200 do
l[y] := t[y];
p1.X := 1;
p1.Y := 1;
p2.X := w;
p2.Y := 1;
p3.X := w;
p3.Y := h;
p4.X := 1;
p4.Y := h;
base1.X := 1;
base1.Y := h+1;
base2.X := w;
base2.Y := h+1;
end;
procedure deholing;
var
x,y,n: integer;
begin
for y := 1 to h do
for x := 1 to w do
t[y][x]:='.';
for y := 1 to h do
for x := 1 to w do
if get(x,y) then
t[y][x] := 'X'
else
begin
n := 0;
if get(x-1,y) then inc(n);
if get(x+1,y) then inc(n);
if get(x,y-1) then inc(n);
if get(x,y+1) then inc(n);
if n>2 then
t[y][x] := 'X';
end;
for y := 1 to h do
for x := 1 to w do
l[y][x] := t[y][x];
end;
function fill_(x,y: integer; var r: TRect):boolean;
var
f,t, i: integer;
begin
if (x < 1) or (y < 1) or (x > w) or (y > h) then
result := false
else
result := l[y][x]='X';
if not result then exit;
l[y][x] := '*';
if y<r.Top then r.Top := y;
if y>r.Bottom then r.Bottom := y;
f := x; // область для дальнейшего сканирования
t := x;
for i := x-1 downto 1 do
if l[y][i] <> 'X' then break else
begin
f := i;
l[y][i] := '*';
if i < r.Left then r.Left := i;
if i > r.Right then r.Right := i;
end;
for i := x+1 to w do
if l[y][i] <> 'X' then break else
begin
t := i;
l[y][i] := '*';
if i < r.Left then r.Left := i;
if i > r.Right then r.Right := i;
end;
for i := f to t do
begin
fill_(i,y-1, r);
fill_(i,y+1, r);
end;
end;
function fill(x,y: integer; var r: TRect):boolean;
begin
r.Left := x;
r.Right := x;
r.Top := y;
r.Bottom := y;
result := fill_(x,y,r);
end;
function rect_in_rect(src, dst: TRect):boolean;
var r: TRect;
begin
r := src;
src.Left := max(src.Left, dst.Left);
src.Right := min(src.Right, dst.Right);
src.Top := max(src.Top, dst.Top);
src.Bottom := min(src.Bottom, dst.Bottom);
result := (src.Right-src.Left+1)*(src.Bottom-src.Top+1) * 100 / ((r.Right-r.Left+1)*(r.Bottom-r.Top+1)) >= 70;
end;
procedure findsymbols;
var
pn,simw,sn,x,y,i,j,n,m,k,nn : integer;
begin
pn := h*85 div 100;
// get fields
smbn := 0;
for y := 1 to h do
for x := 1 to w do
if fill(x,y, smb[smbn+1]) then
inc(smbn);
// remove "char inside of char"
for i := smbn downto 1 do
begin
n := 0;
for j := 1 to smbn do
if i<>j then
if rect_in_rect(smb[i], smb[j]) then
if (smb[i].Right-smb[i].Left+1)*(smb[i].Bottom-smb[i].Top+1)*100/((smb[j].Right-smb[j].Left+1)*(smb[j].Bottom-smb[j].Top+1)) <= 50 then
begin
n := 1;
break;
end;
if n=0 then continue;
for n := i to smbn-1 do
smb[n] := smb[n+1];
dec(smbn);
end;
// precise PN (char width)
j := 0;
n := 0;
for i := 1 to smbn do
begin
m := smb[i].Right-smb[i].Left+1;
if abs(m-pn) <= 4 then // skip small/large "I", "l",...
begin
inc(n);
inc(j, m+2);
end;
end;
if n>1 then // по одному символу судить бесполезно
pn := j div n;
// divide field to symbols
j := pn div 2;
nn := smbn;
for i := 1 to nn do
begin
m := smb[i].Right-smb[i].Left+1;
if m-pn >= j then // DO not use ABS here (leave thin chars)!
begin
{ sn := m div pn; // chars for field
if m-sn*pn >= 2/3*pn then
inc(sn);}
sn := (m+pn div 2) div pn;
simw := m div sn; // width of single char
for k := 1 to sn-1 do
begin
inc(smbn);
smb[smbn].Left := smb[i].Left + k*simw + 1;
if k < sn-1 then
smb[smbn].Right:= smb[smbn].Left + simw - 2
else
smb[smbn].Right:= smb[i].Right - 1;
smb[smbn].Top := smb[i].Top;
smb[smbn].Bottom := smb[i].Bottom;
end;
smb[i].Left := smb[i].Left+1;
smb[i].Right:= smb[i].Left+simw-1;
end;
end;
for y := 1 to h do
for x := 1 to w do
if l[y][x]='*' then
l[y][x] := 'X';
end;
procedure sortsymbols_(L, R: Integer);
var I, J, P: Integer;
t: TRect;
begin
repeat
I := L;
J := R;
P := (L + R) shr 1;
repeat
while smb[i].Left < smb[p].Left do Inc(I);
while smb[j].Left > smb[p].Left do Dec(J);
if I <= J then
begin
t := smb[i]; smb[i] := smb[j]; smb[j] := t;
if P = I then
P := J
else if P = J then
P := I;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then sortsymbols_(L, J);
L := I;
until I >= R;
end;
procedure sortsymbols;
begin
sortsymbols_(1,smbn);
end;
// X,Y - 1-based!
function gett(n,x,y: integer):char;
begin
if (x < 1) or (x > sw[n]) or (y < 1) or (y > sh[n]) then
result := '.'
else
result := ss[sp[n]+y-1][x];
end;
function similarity(lr: TRect; snum: integer):double;
var tw,th,n,nn,x,y,tx,ty: integer;
begin
tw := sw[snum];
th := sh[snum];
n := 0; // число точек вообще в символе который сраниваем из L
nn := 0; // число точек которые совпали с символом в snum
for y := lr.top to lr.bottom do
for x := lr.left to lr.right do
if l[y][x]<>'.' then
begin // проверим эту же точку в итоговой картинке
tx := round((x-lr.left)*tw/(lr.right-lr.left+1)+1);
ty := round((y-lr.top)*th/(lr.bottom-lr.top+1)+1);
if (gett(snum, tx,ty)<>'.') or
(gett(snum, tx,ty-1)<>'.') or
(gett(snum, tx,ty+1)<>'.') or
(gett(snum, tx-1,ty)<>'.') or
(gett(snum, tx+1,ty)<>'.') then
inc(nn);
inc(n);
end;
result := nn/n;
end;
function similarity_back(lr: TRect; snum: integer):double;
var tw,th, n,nn,x,y,lx,ly: integer;
begin
tw := sw[snum];
th := sh[snum];
n := 0; // число точек вообще в символе который сраниваем из L
nn := 0; // число точек которые совпали с символом в snum
for y := 1 to th do
for x := 1 to tw do
if gett(snum,x,y)<>'.' then
begin // проверим эту же точку в итоговой картинке
lx := round((x-1)*(lr.right-lr.left+1)/tw+lr.left);
ly := round((y-1)*(lr.bottom-lr.top+1)/th+lr.top);
if get(lx,ly) or get(lx-1,ly) or get(lx+1,ly) or get(lx,ly-1) or get(lx,ly+1) then
inc(nn);
inc(n);
end;
result := nn/n;
end;
function dofill(x,y: integer; var r: trect): integer;
begin
result := 0;
if l[y][x]<>'.' then exit else l[y][x] := 'E';
inc(result);
if x>r.left then result := result + dofill(x-1,y,r);
if x<r.right then result := result + dofill(x+1,y,r);
if y>r.top then result := result + dofill(x,y-1,r);
if y<r.bottom then result := result + dofill(x,y+1,r);
end;
function getlinks(var r: trect): integer;
var x,y: integer;
begin
result := 0;
for x:=r.left to r.right do
begin
dofill(x,r.top, r);
dofill(x,r.bottom, r);
end;
for y:=r.top+1 to r.bottom-1 do
begin
dofill(r.left,y, r);
dofill(r.right,y, r);
end;
for y := r.top to r.bottom do
for x:=r.left to r.right do
if dofill(x,y, r)>4 then
inc(result);
for y := r.top to r.bottom do
for x:=r.left to r.right do
if l[y][x]='E' then l[y][x] := '.';
end;
// get L-char from rect
function recsymbol(r: TRect):char;
var
i,th,tw,lnk : integer;
s1,s2,s: double;
begin
result := '?';
smax := -1;
lnk := getlinks(r);
for i := 0 to num-1 do
if lnk=links[i mod 26] then
begin
tw := sw[i];
th := sh[i];
if abs(tw/th-(r.Right-r.Left+1)/(r.Bottom-r.Top+1)) > 0.45 then // too bad prop
continue;
s1 := similarity(r, i);
s2 := similarity_back(r, i);
s := (s1+s2)/2;
if s>smax then
begin
smax := s;
result := sc[i+1];
end;
end;
end;
// L to str
function findstr:string;
var i: integer;
begin
denoise;
findrect;
improverect;
rotateRect;
// denoise;
// deholing;
findsymbols;
sortsymbols;
result := '';
for i := 1 to smbn do
result := result + recsymbol(smb[i]);
end;
// a-z = 0..25
// A-Z = 26..51
function lentoc(l: integer):char;
begin
if l<26 then
result := char(byte('a')+l)
else
result := char(byte('A')+(l-26));
end;
function ctolen(c: char):integer;
begin
if (c>='a') and (c<='z') then
result := byte(c)-byte('a')
else
result := byte(c)-byte('A')+26;
end;
function compressline(s: string):string;
var
i,n: integer;
c: char;
begin
c := '.';
n := 0;
result := '';
for i := 1 to length(s) do
if c=s[i] then
inc(n)
else
begin
result := result + lentoc(n);
c := s[i];
n := 1;
end;
if n>0 then
result := result + lentoc(n);
end;
function decompressline(s: string):string;
var
i: integer;
c: char;
begin
if (s[1]='.') or (s[1]='X') then
begin
result := s;
exit;
end;
c := '.';
result := '';
for i := 1 to length(s) do
begin
result := result + stringofchar(c, ctolen(s[i]));
if c='.' then c:='X' else c := '.';
end;
end;
procedure decfonts;
var i: integer;
begin
for i := 0 to sslen-1 do
ss[i] := decompressline(ss[i]);
end;
procedure runmain;
var i,j,n: integer;
begin
decfonts;
readln(n);
for i := 1 to n do
begin
for j := 1 to 200 do
readln(l[j]);
writeln(findstr);
end;
end;
{$IFDEF DLPH}
end.
{$ELSE}
begin
runmain;
end.
{$ENDIF}
|
|||
| ||||