0020-FPI-Packages.st

'From Smalltalk 5.5k XM November 24 on 22 November 1980 at 2:57:08 am.'

"BitImage" 
Class new title: 'BitImage'
	subclassof: Image
	fields: 'strips nstrips'
	declare: 'brush aurora stripheightSPARE stripheight black white bitimagemenu erase SPARE color formmenu under reverse blankcursor over dotsetter ';
	asFollows 

This class is a virtual bit map represented as a smalltalk String

INIT 
classInit 
	["sets up colors and effects for BITBLT."
	black ← 0-1.
	white ← 0.
	over ← 0.
	under ← 1.
	reverse ← 2.
	erase ← 3.
	brush ← Form new extent: 5⌾5. brush black.
	color ← 1.
	stripheight ← 20.
bitimagemenu ← Menu new string:
'size
figure
ground
newform
pasteform
arc
areafill
shade
vertical
horizontal
rotate
'.
	aurora ← "Aurora new" nil.
	]
fromImage: image 
	["creates a virtual bit map with width = (image width) and height = (image height) with the bits in image."
	self fromrectangle: image rectangle.
	]
	
fromrectangle: rect | r i leftover image yposition
	["creates a virtual bit map with width = (r width) , height = (r height)
	 and the bits in rect. The Image is  made up of forms that are stripheight high."
	super origin: rect origin extent: rect extent.
	nstrips ← (rect height + (stripheight -1))/stripheight.
	yposition ← 0.
	leftover ← rect height \ stripheight.
	[ (leftover = 0) ⇒ [leftover ← stripheight]].
	r ← Rectangle new origin: rect origin extent: (rect width)⌾stripheight.
	for⦂ i to: nstrips do⦂ 
		[
		[ i = nstrips ⇒ [ r extent ← ((rect width)⌾leftover)]].
		image ← Image new origin: (0⌾0) extent: rect extent.
		image form: (Form new fromrectangle: r) ; path: (0⌾yposition).
		self addimage: image.
		yposition ← yposition + stripheight.
		r translate: (0⌾stripheight).
		].
	

	]
	
	fromuser  | r
	["create a new Form whose rectangle is specified by the user. "
	r ← Rectangle new fromuser.
	self fromrectangle: r
	]
fromuserevenword  | r
	["create a new BitImage whose rectangle is specified by the user,
		truncated to nearest multiple of 16 (for Spruce printing). "
	r ← Rectangle new fromuserevenword.
	self fromrectangle: r.
	]

PATTERN ACCESS 
erase | i
	["sets all bits in the BitImage to white ( to zeros)"
	for⦂ i to: nstrips do⦂ [ (strips◦i) white]
	]
nstrips
	[
	⇑ nstrips 
	]

nstrips: nstrips 

saveScreenBits
[
]
strips 
	["return the set of Forms making up this BitImage)"
	⇑ strips
	]
strips: strips 


MODULE ACCESS 
comment 
	["see class Image"
	]
frame [ ⇑ rectangle]
moveto: pt  
	[self translateto: pt
	]

FILING 
read: filename | file subimage strip yposition i
	["Reads the Image in the format nstrips , Form(1) , Form(2) , Form(3) . . .
		Form(nstips). Where each Form is saved as width,height then bits.  "
		self origin: 0⌾0 extent: 1⌾1.
		yposition ← 0.
		file← (dp0 oldFile: filename) readonly.
		nstrips ← file nextword.
		for⦂ i to: nstrips do⦂
				[
				strip ← Form new fromInstance: file.  
				self addform: strip andpath: (0⌾yposition).
				yposition← yposition+ strip height.
				].
		file close.
	]
write: filename | file subimage
	["Saves the Form in the format nstrips , Form(1) , Form(2) , Form(3) . . .
		Form(nstips). Where each Form is saved as width,height then bits.  "
		file ← (dp0 file: filename).
		file nextword← nstrips.
		for⦂ subimage from: self do⦂ [ file append: (subimage form) asInstance. ]
		file close.
	]

DISPLAY 
displayat:  path effect: effect clippedBy: cliprect
	[
	super displayat: path effect: effect clippedBy: cliprect
	]
show
	[
	super displayat: (0⌾0) effect: 0 clippedBy: user screenrect
	]

SYSTEM 
copy | t i
	["return a copy of myself"
	t ← BitImage new origin: (origin copy) extent: (self extent) copy.
	for⦂ i to: self length do⦂ [ t add: (self◦i) copy].
	⇑ t
	]
pressCode [⇑3]
printon: strm | t
	[
	strm append: 'a Bitmage: '.
	]

title 
	[
	⇑ ''
	]

EDITING 
arc | pt1 pt2 pt3 p pt
	["arc tool for forms."
	BlankCursor topage1.
	user clear; print: 'Redbug 3 points'; cr; print: 'Paints using current brush.' .
	user waitnobug.
	until⦂ user redbug do⦂	[ pt1 ← self blinkbrush].
	brush displayat: pt1 effect: color clippedBy: user screenrect.
	user waitnobug.
	until⦂ user redbug do⦂		[ pt2 ← self blinkbrush].
	brush displayat: pt2 effect: color clippedBy: user screenrect.
	user waitnobug.
	until⦂ user redbug do⦂	[ pt3 ← self blinkbrush].
	brush displayat: pt3 effect: color clippedBy: user screenrect.
	XeqCursor show.
	p ← Path new init.
	p addarcfrom: pt1 via: pt2 to: pt3.
	for⦂ pt from: p do⦂
					[ brush displayat: pt effect: color clippedBy: user screenrect].
	NormalCursor show
	]

blinkbrush | pt 
	["to show current position of brush in the BitImage."
		pt ← self mp + rectangle origin.
		brush displayat: pt
			effect: 2 clippedBy: user screenrect.
		brush displayat: pt
			effect: 2 clippedBy: user screenrect.
	⇑ pt
	]

edit: superimage | bits 
	["uses the BitRect toolbox editor"
	XeqCursor show.
	dotsetter ← BitRectEditor new picture: self.
	dotsetter firsttime.
	NormalCursor show.
	while⦂ true do⦂ "forever"
		[
		(dotsetter lostMouse and: (user anybug)) ⇒
					[	dotsetter outside⇒ []
						XeqCursor show.
						dotsetter lasttime.
						bits ← self fromrectangle: rectangle.
						NormalCursor show.
						⇑ bits
					]
		dotsetter eachtime
		]
	]

grayEdit | a b c i d p r v bits "edit up a gray pattern and return it"
	["first a rectangle for it.  Then redbug is black, yellow is white,
	blue terminates"
	r ← Rectangle new fromuser. bits←0.
	a ← r extent. a← (a x max:  a y) | 4. a ← a⌾a.
	b ← r origin. r extent← a; color: white mode: storing; moveby: 0⌾(0-a y).
	c ← a/4.  d ← b rect: b+c.
	until⦂ user bluebug do⦂ [
	user redbug ⇒[p ← user mp -b /c.  i ← p y *4 +p x +1.
		i<1 or⦂ i>16 ⇒[r flash]
		d moveto: b+(c*p); color: black mode: storing.
		bits ← bits lor: (1 lshift: 16-i).
		r color: bits mode: storing. user waitnobug]
	user yellowbug ⇒[p ← user mp -b /c.  i ← p y *4 +p x +1.
		i<1 or⦂ i>16 ⇒[r flash]
		d moveto: b+(c*p); color: white mode: storing.
		bits ← (¬1 lxor:(1 lshift: 16-i)) land: bits.
		r color: bits mode: storing. user waitnobug]
	] ⇑bits]
"aa grayEdit base8 ."
horizontalsymmetry | r f i 
	["horizontal symmetry tool"
	user clear; show: 'Define rectangle. Reflection will be around lower edge'.
	r ← Rectangle new fromuser.
	XeqCursor show.
	for⦂ i to: ( r height) do⦂
		[
		f ← Form new fromrectangle: (Rectangle new origin: ((r origin x)⌾((r bottom)-i)) extent: ((r width)⌾1)).
		f displayat: (r origin x)⌾((r bottom) +i) effect: 0 clippedBy: user screenrect.
		].
	NormalCursor show.
	]
line | pt1 pt2 p pt
	["line tool for forms."
	BlankCursor topage1.
	until⦂ user redbug do⦂	[ pt1 ← self blinkbrush].
	brush displayat: pt1 effect: color clippedBy: user screenrect.
	until⦂ user nobug do⦂		[ pt2 ← self blinkbrush].
	brush displayat: pt2 effect: color clippedBy: user screenrect.
	p ← Path new init.
	p addlinefrom: pt1 to: pt2.
	for⦂ pt from: p do⦂
					[ brush displayat: pt effect: color clippedBy: user screenrect].
	NormalCursor topage1
	]

newbrush |  pt rect
	[
	OriginCursor topage1.
	user waitbug.
	pt ← ( self mp)+ rectangle origin.
	rect ← pt rect: pt.	
	CornerCursor topage1.
	until⦂ user nobug do⦂
			[rect reverse.
			rect reverse.
			pt ← 
			( self mp)+ rectangle origin.
			rect corner ← (rect origin) max: pt.
			]
 	brush ← Form new fromrectangle: rect.
	NormalCursor topage1.
	]

pastebrush | pt1 
	["one-copy tool for forms."
	user waitnobug.
	OriginCursor show.
	user waitbug.
	while⦂ user redbug do⦂
		[ pt1 ← self blinkbrush].
	XeqCursor show.
	brush displayat: pt1 effect: (dotsetter tool mode) clippedBy: user screenrect.
	NormalCursor show]
resize: superimage |  pt f
	[dotsetter leave.
	CornerCursor topage1.
	user waitbug. 
	until⦂ user nobug do⦂
			[self reverse.
			self reverse.
			( pt ← 
			(superimage  mp)+
				 superimage rectangle origin).
			self corner← pt max: ((self origin) + (16⌾16)).
			]
 	self fromrectangle: rectangle.
 	self white ; display.
	NormalCursor topage1.
	self edit: superimage
	]

rotate | r f i j
	["90 degree rotation tool"
	r ← Rectangle new fromuser.
	for⦂ i to: ( r width) do⦂
		[
		for⦂ j to: ( r height) do⦂
			[
			f ← Form new fromrectangle: (Rectangle new origin: (((r origin x)+i)⌾(r top+j)) extent: (1⌾1)).
			f displayat: (((r corner x)+j))⌾((r top)+i) effect: 0 clippedBy: user screenrect.
			]
		]
	]
setfigure | t
	["for now just increment the figure color by 1 \ 12"
	figure ← (figure +1 ) \ 12.
	for⦂ t from: self do⦂ [ (t form) figure: figure].
	self display
]

setground | t
	["for now just increment the ground color by 1 \ 12"
	ground ← (ground +1 ) \ 12.
	for⦂ t from: self do⦂ [ (t form) ground: ground].
	self display
]

verticalsymmetry | r f i 
	["vertical symmetry tool"
	user clear; show: 'Define rectangle. Reflection will be around right-hand edge'.
	r ← Rectangle new fromuser.
	XeqCursor show.
	for⦂ i to: ( r width) do⦂
		[
		f ← Form new fromrectangle: (Rectangle new origin: (((r origin x)+(r width)-i)⌾(r top)) extent: (1⌾(r height))).
		f displayat: ((r corner x) + i)⌾(r top) effect: 0 clippedBy: user screenrect.
		].
	NormalCursor show.
	]
yellowbug | 
	[
	bitimagemenu bug
				=1⇒	[self resize: superimage
						]; "change size"
				=2⇒	[self setfigure];		
				=3⇒	[self setground];		
				=4⇒	[self newbrush];		
				=5⇒	[self pastebrush];		
				=6⇒	[self arc ];
				=7⇒	[Rectangle new fromuser fillin: ((dotsetter tool) tone)
							mode: ((dotsetter tool) mode) ];
				=8⇒  [(dotsetter tool) shade];
				=9⇒  [self verticalsymmetry];
				=10⇒  [self horizontalsymmetry];
				=11⇒  [self rotate]
	]

SystemOrganization classify: ↪BitImage under: 'FPI Packages'.
BitImage classInit

"BorderedText" 
Class new title: 'BorderedText'
	subclassof: TextImage
	fields: ''
	declare: '';
	asFollows 

This class has not yet been commented

DISPLAY 
displayat: pt effect: effect clippedBy: cliprect | origin corner
	["display text and border around it "
	super displayat: pt effect: effect clippedBy: cliprect.
	origin ← frame origin.
	corner ← frame corner.
	(Rectangle new
		origin: origin-(1⌾1) corner: (corner x+1)⌾origin y)
	color: ¬1 mode: effect;
	moveto: (origin x-1)⌾corner y; color: ¬1 mode: effect;
	origin ← corner x⌾(origin y-1); color: ¬1 mode: effect;
	moveto: origin-(1⌾1); color: ¬1 mode: effect
	]

SYSTEM 
copy | t
	[
	t ←  BorderedText new paragraph: para copy frame: (frame copy) style: style copy.
	t c1← c1 ; c2← c2 ; begintypein ← begintypein.
	⇑ t
	]
pressCode [⇑6]
presson: press in: r | scale
	[
	scale ← press scale.
	press setp: (r origin x- scale)⌾(r corner y-(3*scale)) ;
		showrectwidth: (scale*(2+self width)) height: scale.
	press setp: (r origin x- scale)⌾(r corner y-((self height+5)*scale)) ;
		showrectwidth: (scale*(2+self width)) height: scale.
	press setp: (r origin x- scale)⌾(r corner y-(scale*(self height+4))) ;
		showrectwidth: scale height: (scale*(self height+2)).
	press setp: (r origin x+(scale*(self width)))⌾(r corner y-(scale*(self height+4))) ;
		showrectwidth: scale height: (scale*(self height+2)).

⇑ para presson: press in: r.
	]

SystemOrganization classify: ↪BorderedText under: 'FPI Packages'.

"Document" 
Class new title: 'Document'
	subclassof: Image
	fields: 'displayorder style'
	declare: 'leading micasperinch ';
	asFollows 

basic document class

EDITING 
bubbledelete: image | delta i k
	["delete image from the document  and subtracting images extent y from all subimages below it."
	i ← self find: image.
	i⇒ [
			self deleteI: i .
			delta ← image extent y.
			for⦂ k from: i to: self length do⦂
				[
				(self◦k) translate: (0⌾(0-delta))
				]
		
		]
	]
bubbleinsert: image | delta i k
	["insert image into the document keeping the document y-sorted and adding images extent y to all subimages below it."
	i ← self findindex: image.
	self insertI: i value: image.
	delta ← image extent y.
	for⦂ k from: i+1 to: self length do⦂
		[
		(self◦k) translate: (0⌾delta)
		].
	
	]
delete: image |  i 
	["delete image from the document and leave its space. "
	i ← self find: image.
	i⇒ [ self deleteI: i.]
	]
edit 
	["Documents are edited with a DocumentEditor"
	DocumentEditor new init: self.
	]
findindex: image | y guess top bottom
	["binary search on the origins of the rectangles surrounding my subimages
		returns the index of the subimage just below image."
	position = 0 ⇒ [ ⇑ 1]
	top ← 1.
	bottom ← position.
	y← image rectangle origin y.
	y ≤ ((self◦1) rectangle origin y) ⇒ [ ⇑ 1].
	y ≥ ((self◦position) rectangle origin y) ⇒ [ ⇑ position+1]
	guess ← position/2.
	until⦂  bottom = (top+1) do⦂
		[
			[((self◦guess) rectangle origin y) ≥ y ⇒ [ bottom ← guess ] top ← guess].
			guess ← (bottom + top) /2
		]
	⇑ bottom
	
	]
insert: image | i
	["insert image into the document keeping the document y-sorted."
	i ← self findindex: image.
	self insertI: i value: image.
	]
resize | delta t
	["make sure the document does not have subimages that have negative y values and resize the document"
	[position ≥ 1 ⇒
		[
		(delta ← (self◦1) top) ≤ 0 ⇒ 
			[
			for⦂ t from: self do⦂ [ t translate: (0⌾(0-delta)) ] 
			]
		]
	].
	super resize
	]

INIT 
classInit 
	[
	micasperinch ← 2540.
	]
name
[ ⇑  displayorder "returns the name of the document ( displayorder is currently used for name... note that name is a string."
 ] 
	

name: displayorder 
	["sets the name of the document ( displayorder is currently used for name... note that name is a string."
	]

SYSTEM 
copy | im i
[
	im ← Document new origin: origin copy rectangle: rectangle copy path: path copy form: form copy figure: figure copy ground: ground copy xgrid: xgrid copy  ygrid: ygrid copy.
	for⦂ i to: self length do⦂ 
		[im add: (self◦i) copy].
	im name: (self name) copy.
	⇑ im
]
fromPress: displayorder | press s
	["retrieves an instance of class Document from a press file"
	user displayoffwhile⦂ 
		[
	self default.
	 press ← (dp0 pressfile: displayorder). press open.
	s ← (press nextControl) asStream.
	s next = self pressCode ⇒ [self fromPress: press value: s]
	user notify: 'error in pressfile'.
		]
	]
fromPress: press value:  s | numberofsubimages t t1 i code 
	["builds an instance of class Document from a press file"
	numberofsubimages← s nextword.
	origin ← s nextPoint.
	t ← s nextPoint.
	t1 ← s nextPoint.
	rectangle ← t rect: t1.
	xgrid ← s nextword.
	ygrid ← s nextword.
	displayorder← s nextString.	
	for⦂ i to: numberofsubimages do⦂
				[s ← (press nextControl) asStream.
				code ← s next. 
				t ← [code = 1⇒ [Image new]; = 2⇒ [Heading new];
					= 3⇒ [BitImage new] false].
				t and⦂ code = t pressCode⇒ [
					self addimage: (t fromPress: press value: s)]
				user notify: 'illegal code or code mismatch']	
	⇑ self
	]
hardcopy |	p i press bottoms rect pressscale pageheight pagewidth  lastrect 				currentrect oldytop oldybottom 
	[
	oldytop ← 11*micasperinch.
	pageheight ← 11*micasperinch.
	pagewidth← 8*micasperinch.
	
	user displayoffwhile⦂ 
	[
	press ← dp0 pressfile: (displayorder + '.doc').
	pressscale ← press scale.
	self hidePress: press complete: ¬1.
	p ← PressPrinter init.
	p press: press;
		frame ←  ("in micas"
				((1*micasperinch)⌾(1*micasperinch)) rect:
				((pagewidth-micasperinch)⌾(pageheight-micasperinch))).

	lastrect ← ((self◦1) rectangle)*pressscale.
	rect ← ((lastrect leftside)⌾(1*micasperinch))
	rect: ((lastrect rightside) ⌾(pageheight - (lastrect top))).
	oldybottom ← p print: self◦1 in: rect.
	for⦂ i from: (2 to: self length) do⦂
			[
			[oldybottom > oldytop⇒ 
				["page break" oldytop ← pageheight-micasperinch.
				]].
			currentrect← ((self◦i) rectangle) * pressscale.
			[(currentrect top > lastrect bottom)⇒
				[oldytop ← oldybottom+(lastrect bottom-currentrect top)"no overlap"]
				oldytop ← (oldytop+(lastrect top-currentrect top))"overlap"].
			rect ← ((currentrect leftside)⌾(1*micasperinch))
			rect: ((currentrect rightside) ⌾(oldytop)).
			oldybottom ← p print: (self◦i) in: rect.
			lastrect ← ((self◦i) rectangle)*pressscale.
			].

	press close; toPrinter "send over ethernet to printer"]
	]
hideData: complete | s
	["stores an instance of class Document from a press file"
	s ← Stream new of: (String new: 100).
	s nextword← self length; "number of subimages"
		nextPoint← origin;
		nextPoint← rectangle origin;
		nextPoint← rectangle corner;
		nextword← xgrid;
		nextword← ygrid;
		nextString← displayorder.	
	⇑ s contents]
pressCode [⇑0]
printon: strm | t
	[
	strm append: 'a Document '.
	]

SystemOrganization classify: ↪Document under: 'FPI Packages'.
Document classInit

"DocumentEditor" 
Class new title: 'DocumentEditor'
	subclassof: Window
	fields: 'document documentwindow screenimage firstindex lastindex
	indexofselection selection '
	declare: 'jumpcursor documentmenu scrap blankcursor ';
	asFollows 

This class has not yet been commented

INIT 
buildscreenimage | i r delta  
	["This function copies the subimages intersecting the document window
		into the screen image."
	screenimage ← Image new origin: self frame origin extent: self frame extent.
	screenimage  xgrid: (document xgrid) ; ygrid: (document ygrid).
	delta ← documentwindow origin y.
	firstindex ← 1.
		" find the index of the first subimage that intersects the document window."
	until⦂ ((firstindex≥(document length)) or⦂
		((((document◦firstindex) rectangle) bottom) > (documentwindow top))) do⦂
		[firstindex ← firstindex+1].
	lastindex ← firstindex.
	for⦂ i from: (firstindex to: document length) do⦂
		[
			((((document◦i) rectangle) top) < (documentwindow bottom))⇒
					[lastindex ← i. screenimage add: (((document◦i) "copy")
													translate: 0⌾0 - (0⌾delta))
					] ⇑ lastindex
		].
	
]
classInit 
"  DocumentEditor classInit.    "
[	documentmenu ← Menu new string:
'move
erase
place
cut
paste
copy
top
bottom
jump
addspace
deletespace
show
'.
	jumpcursor ← Cursor new fromtext: '
1111111111111111
1111111111111111
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000001110000000
0000011111000000
0000011111000000
0000001110000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
1111111111111111
1111111111111111' offset: 2⌾1.
]


defaultdocument 
[
	self defaultdocument: 'document'
]
defaultdocument: name | defaultdocument run r textimage f im dot heading head text char b image row
[" name is a string"
	defaultdocument ← Document new origin: 0⌾0
									extent: (user screenrect) extent.
	defaultdocument name: name.
	defaultdocument xgrid: DefaultTextStyle tab.
	defaultdocument ygrid: DefaultTextStyle lineheight.
	
	textimage ← BorderedText new.
	textimage text: 'Text that is bordered' width: 200.
	defaultdocument addform: textimage andpath: 0⌾0.

	textimage ← TextImage new.
	textimage text: 'This is a paragraph' width: 600.
	defaultdocument addform: textimage andpath: 0⌾0.
	
	b ← BitImage new fromrectangle:
				(Rectangle new origin: 0⌾200 extent: 100⌾100).
	defaultdocument insert: b.
	head ← Set new default.
	text ← 'HEADING'.
	for⦂ char from: text do⦂ [ head add: char ].
	heading ← Heading new origin: 0⌾400 index: 9 charactercodes: head
		currentcharacter: 0.
	defaultdocument insert: heading.
	"defaultdocument insert: CurveIdiom new init."
	self init: defaultdocument.
]
init: document | i 
	["This is the paragraph (subimage) level document editor."
	self fixedwidthfromuser: document width.
	documentwindow ← Rectangle new origin: document rectangle origin
									extent: (document width) ⌾ (self frame height).
	self buildscreenimage.
	selection ← false.
	user topWindow leave.
	self takeCursor; enter.
	user restartup: self
	]

DEFAULT EVENT RESPONSES 
close
[
	XeqCursor show.
	document close.
	document ← nil.
	screenimage ← Vector new: 0.
	NormalCursor show
]
enter [selection ← false. self show]
hardcopy
	["write a press file and hardcopy this document"
	self leave.
	self top.
	document hardcopy
	]
kbd | c x y
[
	   c ← user kbd. 
 	c = 120⇒
 		[ user clearshow: 'x gridding is '. document xgrid print.
 		user cr.
 		document xgrid: (x←
 		(user request: 'x gridding . . . ') asInteger).
		screenimage xgrid: x. 
 		] 
 	c = 121⇒
 		[ user clearshow: 'y gridding is '. document ygrid print.
 		user cr.
 		document ygrid: (y←
 		(user request: 'y gridding . . . ') asInteger).
		screenimage ygrid: y.
 		] 
]

leave
	[
	document ≡ nil ⇒ []
	[selection⇒ [ selection highlite]].
	self update ; buildscreenimage.
	selection ← false.
	]
print 
	["write a press file and hardcopy this document"
	document hardcopy
	]
redbug | pt rect newrect start t
	[pt ← user mp.
	start←pt.
	rect←newrect←(Rectangle new origin: start corner: start).
	[selection⇒ [selection highlite. self deselect. selection ← false.]]. 
	while⦂ user anybug do⦂
		[rect←newrect.
		rect comp.
		t←user mp.
		newrect←(Rectangle new origin: (start min: t) corner: (start max: t)).
		rect comp].
	(rect width < 10) ⇒
		[
		selection ←
			screenimage smallestsubimageat:  pt- screenimage origin.
		selection⇒
				[
				selection  translate: screenimage origin.
				selection edit: screenimage.
				selection translate: ((0⌾0) - screenimage origin).
				selection ← false.
				]
		]
		rect origin ← screenimage griddedpoint: (rect origin).
		selection ← screenimage subimageswithin: 
									(rect translate: ((0⌾0)- screenimage origin)).
		selection ⇒
		[selection translate: screenimage origin ; highlite]
	]
yellowbug | pt
	[
	documentmenu bug
		=1⇒[self move];
		=2⇒[self delete];
		=3⇒[self place];
		=4⇒[self cut];
		=5⇒[self paste];
		=6⇒[self copyselection];
		=7⇒[self top];
		=8⇒[self bottom];
		=9⇒[self jump];
		=10⇒[self addspace];
		=11⇒[self deletespace];
		=12⇒[self deselect. selection ← false. self show]
	
	]

FRAMING 
newframe
	[self update.
	self fixedwidthfromuser: document width.
	self buildscreenimage ; show.
	]
show [
	XeqCursor show.
	self outline .
	growing⇒[]
	titleframe put: (Paragraph new text: self title runs: titlerun alignment: 0)
		at: frame origin+titleloc; window outline; show.
	screenimage  white.
	screenimage displayat: 0⌾0 effect: 1 clippedBy: self frame.
	selection ⇒ [ selection boxcomp].
	NormalCursor show

	]
title [ ⇑ document name] 

EDITING 
addspace | image i k r delta
	["add whitespace to the document  ."
	self update. selection ← false.
	r ← document rectanglefromuser.
	i ← (document indexofsubimagebelow: (r top- screenimage top) + documentwindow top).
	[i⇒ 	[
			delta ← r height.
			for⦂ k from: i to: document length do⦂
				[
				(document◦k) translate: (0⌾(delta))
				].
		document resize
		]
			].
	self buildscreenimage ; show.
	]
bottom |  i delta 
	["translate the current selection to the bottom of the window and update the document to reflect any changes in the subimages which are scrolled out of the screenimage."
	selection⇒
		[
		delta ← (selection rectangle corner - screenimage rectangle corner).
		self update. selection ← false.
		documentwindow translate: (0⌾ (delta y)). "move window on document"
		self buildscreenimage ; show. 
			"reconstruct screen image, including reestablishing  first and last indices"
		]
		self update.
		documentwindow ← Rectangle new origin:
											(document rectangle corner-self frame height)
										extent: (document width) ⌾ (self frame height).
		self buildscreenimage ; show.
	]

closeScrap
	[
	scrap ≡ nil⇒ []
	scrap close
	]
copy | 
	["copy the selection and put it in scrap"
	self copyselection
	]
copyselection | 
	["copy the selection and put it in scrap"
	selection⇒
		[
		XeqCursor show.
		self closeScrap.
		scrap ← selection copy.
		NormalCursor show
		]
	frame flash
	]
cut | t 
	["delete subimage (paragraph) from the screenimage and save it in the scrap"
	selection⇒
		[
		XeqCursor show.
		self closeScrap.
		scrap ← selection.
		self update.
		for⦂ t from: selection do⦂
			[
			document bubbledelete: t.
			].
		selection ← false.
		self buildscreenimage ; show.
		NormalCursor show
		]
	frame flash
	]
delete | t
	["delete subimage (paragraph) from the screenimage and save it in the scrap"
	selection⇒
		[
		XeqCursor show.
		self closeScrap.
		scrap ← selection.
		selection highlite ;  display: 3.
		for⦂ t from: selection do⦂
		[screenimage delete: t
		]. 
		selection ← false.
		NormalCursor show.
		]
	frame flash
	]
deletespace | image i k r delta
	["delete whitespace from the document  ."
	self update. selection ← false.
	r ← document rectanglefromuser.
	i ← (document indexofsubimagebelow: (r top - screenimage top) + documentwindow top).
	[i⇒ 	[
			delta ← r height.
			for⦂ k from: i to: document length do⦂
				[
				(document◦k) translate: (0⌾(0-delta))
				].
		document resize
		]
			].
	self buildscreenimage ; show.
	]
deselect | t
		[selection⇒ [
						selection translate: ((0⌾0) - screenimage origin).
						for⦂ t from: selection do⦂
							[t translate: selection origin
							].

						 ]
		] 
editTitle
	[titlepara←document name asParagraph.
	super editTitle.
	document name: titlepara text]
jump
	|  y deltay yprime deltayprime rect pt newY scal r
	[user waitnobug.
	XeqCursor show.
	self update.
	y ← document height.
	yprime ← frame height.
	deltay ← (documentwindow origin y) - (document  origin y).
	scal←yprime asFloat/y.
	deltayprime ← (scal*deltay) asInteger.
	pt ← ((screenimage leftside+((1.0-scal)*frame width/2))⌾((screenimage top) + deltayprime)).
	document quickDisplayAt: 0⌾0 scale: scal offset: (frame minX + ((1.0-scal)*frame width/2))⌾frame minY.
	rect←0⌾0 rect: 1⌾1.
	rect origin ← pt.
	rect corner x←pt x +(scal*frame width) asInteger.
	rect corner y←pt y + (scal*frame height) asInteger.
	user cursorloc←pt.
	OriginCursor show.
	user waitbug.
	[user redbug
		⇒	[rect comp.
			while⦂ user redbug do⦂
				[r←rect copy.
				newY←user mp y.
				[newY<(frame minY- rect height) ⇒ [newY←frame minY-rect height]].
				[newY>frame maxY ⇒ [newY←frame maxY]].
				rect translateto: pt x⌾newY.
				r comp.
				rect comp].
			rect comp.
			XeqCursor show.
			deltayprime ← newY - (frame origin y).
			deltay ← y*deltayprime/yprime.
			documentwindow translateto: (0⌾deltay).
			selection ← false]].
	self buildscreenimage.
	self show.
	NormalCursor show]
move | pt t
	["used to place subimages (paragraphs) in the Image."
	selection
		⇒	[user waitnobug.
			OriginCursor show.
			user waitbug. 
			selection highlite ; displayat: 0⌾0 effect: 3 clippedBy: frame.
			while⦂ user redbug do⦂
				[pt ←screenimage mp + screenimage rectangle origin.
				selection translateto: pt.
				selection blink].
			XeqCursor show.
			selection displayat: 0⌾0 effect: 1 clippedBy: frame .
			self deselect.
			selection ← false.
			NormalCursor show]
		frame flash]
paste | pt t

["add the subimage (paragraph) in the scrap to the screenimage."
		[
		selection⇒ [selection highlite]].
		self update.
		selection ← scrap copy.
		OriginCursor showwhile⦂
		[
		user waitbug.
		until⦂ user nobug do⦂
			[
			pt ←screenimage mp + screenimage rectangle origin.
			selection  translateto: pt ; blink
			]
		selection displayat: 0⌾0 effect: 1 clippedBy: self frame .
		].
	self deselect.
	for⦂ t from: selection do⦂
		[
		document bubbleinsert: (t translate: documentwindow origin).
		].
	selection ← false.
	self buildscreenimage ; show.
	]
place | pt tempimage t

["add the image in the scrap to the screenimage."
	[selection⇒[selection highlite]].
	self deselect.
	selection ← scrap copy.
		OriginCursor showwhile⦂
		[
		user waitbug.
		until⦂ user nobug do⦂
			[
			pt ←screenimage mp + screenimage rectangle origin.
			selection translateto: pt ; blink
			]
		].
	selection  displayat: 0⌾0 effect: 1 clippedBy: self frame.
	self deselect.
	for⦂ t from: selection do⦂
		[
			screenimage add: t.
		].
	selection ← false.
	
	]
top |  i delta 
	["translate the current selection to the top of the window and update the document to reflect any changes in the subimages which are scrolled out of the screenimage."
	selection⇒
		[
		delta ← (selection rectangle origin - screenimage rectangle origin).
		self update. selection ← false.
		documentwindow translate: (0⌾ (delta y)). "move window on document"
		 self buildscreenimage ; show. 
			"reconstruct screen image, including reestablishing  first and last indices"
		]
	self update.
	documentwindow ← Rectangle new origin: document rectangle origin
									extent: (document width) ⌾ (self frame height).
	self buildscreenimage ; show.
	]

update |  i 
	["update the document to reflect any changes in the subimages ."
	XeqCursor topage1.
		[selection⇒	[self deselect]].
		document deleteI: firstindex to: lastindex. "update document"
		for⦂ i to: screenimage length  do⦂ 
			[document insert: 
							(screenimage◦i translate: (0⌾documentwindow origin y)).
			].
	document resize.
	NormalCursor topage1.
	]


SystemOrganization classify: ↪DocumentEditor under: 'FPI Packages'.
DocumentEditor classInit

"Heading" 
Class new title: 'Heading'
	subclassof: Image
	fields: 'formset index charactercodes currentcharacter'
	declare: 'headingmenu ';
	asFollows 

This class has not yet been commented

INIT 
classInit 
	["menu for the Heading edits."

headingmenu ← Menu new string:
'right
left
up
down
font
'.

	]
origin: origin formset: formset currentcharacter: currentcharacter
	["initilization of a Heading (used in copy)"
	[formset is: Integer⇒ [ formset ← FormSet new fromstyle:
						DefaultTextStyle styleindex: formset.]].
	self origin: origin extent: (200⌾formset height).
	]
origin: origin index: index charactercodes: charactercodes
		currentcharacter: currentcharacter | char w delta
	["initilization of a Heading (used in copy)"
	formset ← FormSet new fromstyle:
						DefaultTextStyle styleindex: index.
	[ nil ≡ charactercodes ⇒ [ charactercodes ← Set new default]].
	self origin: origin extent: (200⌾formset height).
	w ← 0.
	delta ← origin copy.
	self translate: (0⌾0 - delta).		
	for⦂ char from: charactercodes do⦂
		[	char ← formset asForm: char.
			self addpath: w⌾0 andform: char.
			w ← w + char width.
		]
	self translate: delta.
	⇑ self
	]

EDIT 
down | delta
	["move the current character down one bit."
	self boxcomp.
	(self◦currentcharacter) translate: (0⌾1).
	delta ← origin copy.
	self translate: (0⌾0 - delta) ; resize ; translate: delta.
	self white ; display: 1.
	self boxcomp.
	]
edit: parentimage | pt 
	["Simple Heading (line) editor for now."
	self display: 0.
	until⦂ 1=2 do⦂ "forever for now"
		[
		user kbck⇒
		[ self typein ]
		user yellowbug ⇒	[
			headingmenu bug
				=1⇒	[self right]; "move current character right one bit"
				=2⇒	[self left]; "move current character left one bit"
				=3⇒	[self up]; "move current character up one bit"
				=4⇒	[self down]; "move current character down one bit"
				=5⇒	[self newfont] "change fonts"
									]
		user redbug ⇒ 		[(rectangle has: (pt← user mp))⇒
										[pt ← pt - (rectangle origin).
										currentcharacter← self indexofsubimageat: pt.
										currentcharacter⇒
											[
											self◦currentcharacter displayat: self origin
											effect: 2 clippedBy: user screenrect.
											self◦currentcharacter displayat: self origin
											effect: 2 clippedBy: user screenrect.
											]
										]
										⇑ self
									]
		user bluebug ⇒ 		[
									⇑ self.
									] "exit back to the parentimage" 
		]
	]
left | i delta
	["move the current character and all those to the right of it to the left one bit."
	self boxcomp.
	for⦂ i from: (currentcharacter to: self length) do⦂
		[ (self◦i) translate: (0⌾0) -(1⌾0) ].
	delta ← origin copy.
	self translate: (0⌾0 - delta) ; resize ; translate: delta.
	self white ; display: 1.
	self boxcomp.
	]
newfont | w char charcount delta i
	[
	index ←(user request: 'index of new font . .  ' ) asInteger.
	formset ← FormSet new fromstyle: DefaultTextStyle styleindex: index.
	self white.
	for⦂ i to: position do⦂ [ self◦i ← nil ].
	position ← 0.
	w ← 0.
	charcount ← 0.
	delta ← origin copy.
	self translate: (0⌾0 - delta).		
	for⦂ char from: charactercodes do⦂
		[nil≡ char ⇒ []
		char ← formset asForm: char.
		char displayat: delta+ (w⌾0) effect: 0 clippedBy: user screenrect.
		self addpath: w⌾0 andform: char.
		w ← w + char width.
		charcount ← charcount+1.
		]
	self resize.
	self translate: delta.
	⇑ self
	]
right | i delta
	["move the current character and all those to the right of it to the right one bit."
	self boxcomp.
	for⦂ i from: (currentcharacter to: self length) do⦂ [ (self◦i) translate: (1⌾0) ].
	delta ← origin copy.
	self translate: (0⌾0 - delta) ; resize ; translate: delta.
	self white ; display: 1.
	self boxcomp.
	]
typein | w char charcount delta i
	[
	self white.
	for⦂ i to: position do⦂ [ self◦i ← nil ].
	position ← 0.
	w ← 0.
	charcount ← 0.
	charactercodes ← Set new default.
	delta ← origin copy.
	self translate: (0⌾0 - delta).		
	until⦂ (char ← user kbd) = 13 do⦂
		[			
			(char = 8) ⇒"back space" 
					[charcount ≠  0 ⇒ [ 
							 					w ← w - ( (self◦charcount) width).
												(self◦charcount) white.
												self deleteimage: charcount.
												charactercodes deleteI: charcount.
												charcount ← charcount -1.
												]
					]
			charactercodes add: char.
			char ← formset asForm: char.
			char displayat: delta+ (w⌾0) effect: 0 clippedBy: user screenrect.
			self addpath: w⌾0 andform: char.
			w ← w + char width.
			charcount ← charcount+1.
		]	
	self resize.
	self translate: delta.
	⇑ self
	]
up | delta
	["move the current character up one bit."
	self boxcomp.
	(self◦currentcharacter) translate: (0⌾0) - (0⌾1).
	delta ← origin copy.
	self translate: (0⌾0 - delta) ; resize ; translate: delta.
	self white ; display: 1.
	self boxcomp.
	]

SYSTEM 
copy | h i
	[
	h← Heading new origin: (rectangle origin) copy index: index charactercodes: (charactercodes copy)
		currentcharacter: currentcharacter copy.
	h rectangle: rectangle copy.
	for⦂ i to: self length do⦂ 
		[
		h add: (self◦i) copy 
		]
	⇑ h
	]
fromPress: press value:  s | numberofcharacters  i 
	["retrieves and builds an instance of class Heading from a press file"
	numberofcharacters← s nextword.
	origin ← s nextPoint.
	index ← s nextword.
	charactercodes ← Set new default.

	for⦂ i to: numberofcharacters do⦂
				[ charactercodes add: s nextword ]	
	⇑ self origin: origin index: index charactercodes: charactercodes
		currentcharacter: 1
	]
hideData: complete | s i
	["stores an instance of class Heading on a press file"
	s ← Stream new of: (String new: 100).
	s nextword← self length; "number of characters"
		nextPoint← origin;
		nextword ← index.
	for⦂ i to: self length do⦂ [s nextword ← charactercodes◦i].
	⇑ s contents]
pressCode [⇑2]
presson: press in: r | hs y t i pressscale [
	(hs  ← press scale*self height) > r height⇒ [
		"not enough room left on current page.
		assume for now that it will at least fit on an entire page"
		⇑ self]

	self hidePress: press complete: ¬1.
	pressscale ← press scale.
	press selectfont: (press fontindex: 16*index style: DefaultTextStyle) - 1.

	for⦂ i to: self length  do⦂
		[
		press setx:  r leftside + ((self◦i) leftside*pressscale).
		press sety: r bottom - ((self◦i) top*pressscale).
		press showchar: (charactercodes◦i)
		].
	⇑ r bottom - ((self height)*pressscale)]
printon: strm | t [
	strm append: 'a Heading '.
	]

SystemOrganization classify: ↪Heading under: 'FPI Packages'.
Heading classInit