Class new title: TextScanner
	subclassof: BitBlt
	fields: 'printing chari stopx xtable exceptions spacecount spacei spacex charpad text spacesize style para font fontno minascii maxascii glyphs frame looktype'
	declare: 'space defaultExceptions tab cr bs '

callBLT 
	[user croak] primitive: 40

chari [chari]

classInit 
	[space _ 32.
	tab _ 9.
	cr _ 13.
	defaultExceptions _ String new: 256.
	defaultExceptions all_ 0.
	defaultExceptions  space + 1 _ 12.
	defaultExceptions  tab + 1 _ 13.
	defaultExceptions  cr + 1 _ 4]

emphasize: t1 leftx: t2 rightx: t3 liney: t4 | t5 t6 
	[[font  nil or font height = style lineheight  []
	[font ascent < style baseline 
		[t5 _ t4 + (style baseline - font ascent).
		(t2  t4 rect: t3  t5) clear: white]].
	font descent < (style lineheight - style baseline) 
		[t5 _ t4 + (style baseline + font descent).
		t6 _ t5 + (style lineheight - (style baseline + font descent)).
		(t2  t5 rect: t3  t6) clear: white]].
	t1 = 0  []
	[t1  8 
		[t1 _ t1 - 8.
		t5 _ t4 + (style baseline / 2).
		(t2  t5 rect: t3  (t5 + 1)) clear: black]].
	[t1  4 
		[t1 _ t1 - 4.
		t5 _ t4 + style baseline.
		(t2  t5 rect: t3  (t5 + 1)) clear: black]].
	[t1  2 
		[t1 _ t1 - 2.
		t5 _ t4 + style lineheight - 4.
		until t5 
 t4 do
			[(t2  t4 rect: t3 - 1  t5) blt: t2 + 1  t4 mode: storing.
			(t2  t4 rect: t2 + 1  t5) clear: white.
			t5 _ t5 - 4]]].
	t1  1 
		[t1 _ t1 - 1.
		(t2  t4 rect: t3  (t4 + style lineheight)) blt: t2 + 1  t4 mode: oring]]

exceptionTable: t1 
	[exceptions _ t1]

frame: t1 window: t2 para: t3 style: t4 printing: t5 
	[frame _ t1.
	para _ t3.
	style _ t4.
	printing _ t5.
	super init.
	self toDisplay.
	exceptions _ defaultExceptions.
	fontno _ 1.
	para _ para asParagraph.
	text _ para text.
	NoteTaker  [self window: t2]]

leftx 
	[destx - width]

rightx [destx]

scanline: t1 at: t2 stopx: t3 stopchar: t4 | t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 
	[stopx _ t3.
	chari _ t1 starti - 1.
	spacecount _ t1 spaces.
	t11 _ t1 padwidth.
	t6 _ frame minX.
	spacex _ t6.
	destx _ spacex.
	t14 _ 0.
	charpad _ t14.
	t8 _ charpad.
	t13 _ style tabsize.
	spacei _ 1.
	t15 _ para alignment.
	[t15 = 0  []
	t15 = 1 
		[spacecount > 0 
			[charpad _ t11 / (t1 stopi - chari + spacecount).
			[charpad > 0 
				[t11 _ t11 - (charpad * (t1 stopi - chari - 2 - spacecount)).
				printing  [(frame minX  t2 rect: frame maxX  (t2 + style lineheight)) clear: white]]].
			t14 _ t11 / spacecount.
			spacecount _ spacecount - (t11 \ spacecount)]]
	t15 = 2  [destx _ destx + (t11 / 2)]
	t15 = 4  [destx _ destx + t11]].
	t7 _ 10.
	until t7 < 10 do
		[t7 = 10 
			[t7 _ 255.
			chari  t4  [t7 _ 3]
			[printing  [self emphasize: t8 leftx: t6 rightx: destx liney: t2]].
			t6 _ destx.
			chari _ chari + 1.
			t9 _ para runAndVal: chari.
			t8 _ t9  2 land: 15.
			t10 _ t9  1 + chari - 1 min: t4.
			self setfont: (t9  2 lshift: 4) liney: t2]
		[NoteTaker  []
		sourcebase _ glyphs lock].
		t7 _ self scanword: t10.
		[NoteTaker  []
		glyphs unlock].
		t7 > 10 
			[[t7 = 12 
				[spacecount _ spacecount - 1.
				[spacecount = 0  [t14 _ t14 + 1]].
				spacei _ chari.
				spacex _ destx.
				width _ spacesize + t14.
				printing 
					[function _ 28.
					self callBLT]]
			t7 = 13 
				[t12 _ destx - frame minX.
				width _ [para alignment > 0  [t13 + charpad]
						t12 + t13 | t13 - t12].
				printing 
					[function _ 28.
					self callBLT]]
			[t7 = 11  [t5 _ maxascii + 1]].
			sourcex _ xtable  (t5 + 1).
			width _ xtable  (t5 + 2) - sourcex.
			[printing 
				[function _ 16.
				self callBLT]].
			width _ width + charpad].
			destx _ destx + width.
			destx > stopx  [t7 _ 2]
			chari  t10  [t7 _ 10]
			chari _ chari + 1]
		t7 = 4  [width _ 0]].
	printing  [self emphasize: t8 leftx: t6 rightx: destx liney: t2]]

scanword: t1 | t2 
	[function _ 16.
	until chari > t1 do
		[t2 _ text  chari.
		exceptions  (t2 + 1)  0  [exceptions  (t2 + 1)]
		t2 < minascii or t2 > maxascii  [11]
		sourcex _ xtable  (t2 + 1).
		width _ xtable  (t2 + 2) - sourcex.
		[printing  [self callBLT]].
		width _ width + charpad.
		destx _ destx + width.
		destx > stopx  [2]
		chari _ chari + 1].
	chari _ chari - 1.
	10] primitive: 50

setfont: t1 liney: t2 
	[t1 = fontno  [desty _ t2 + style baseline - font ascent]
	fontno _ t1.
	font _ style font: fontno.
	xtable _ font xtable.
	spacesize _ font spacewidth.
	minascii _ font minascii.
	maxascii _ font maxascii.
	glyphs _ font glyphs.
	printing 
		[sourceraster _ font raster.
		desty _ t2 + style baseline - font ascent.
		height _ font height.
		NoteTaker 
			[sourcebase _ glyphs.
			sourcefield _ height + 1 / 2 * sourceraster]]]

spacecount 
	[0 - spacecount]

spacei [spacei]

spacex [spacex]

toDisplay 
	[NoteTaker  [self destForm_ DisplayForm]
	destbase _ mem  54.
	destraster _ user screenrect width / 32 * 2]

type: t1 
	[exceptions  (t1 + 1)  0  [exceptions  (t1 + 1)]
	[t1 < minascii or t1 > maxascii  [t1 _ maxascii + 1]].
	stopx _ frame maxX.
	sourcex _ xtable  (t1 + 1).
	[t1  space and t1  tab  [width _ xtable  (t1 + 2) - sourcex]
	t1 = space  [width _ spacesize]
	width _ style tabsize].
	destx + width > stopx or t1 = cr  [1]
	(destx  desty rect: stopx - width  (desty + height)) blt: destx + width  desty mode: storing.
	[t1  space and t1  tab  [function _ 16]
	function _ 28].
	[NoteTaker or function = 28  [self callBLT]
	sourcebase _ glyphs lock.
	self callBLT.
	glyphs unlock].
	destx _ destx + width.
	0]