’From Smalltalk 5.5k XM November 24 on 22 November 1980 at 2:57:08 am.’
"BitRect"
Class new title: ’BitRect’
subclassof: Rectangle
fields: ’title "<String> title of picture"
stripheight "<Integer> scan lines in a buffer (private)"
data "<Vector> of Strings. Saves the bits in the Rectangle"’
declare: ’defaultpic ’;
asFollows
BitRect is a Rectangle that remembers the bits within it.
To create and edit one, say:
BitRect new fromuser edit.
This installs a BitRectEditor in the scheduler and starts it up.
The editor is explained in BitRectEditor.
Initialization
classInit
["the default picture is a gray rectangle"
defaultpic ← BitRect new filin: ’defaultpic’]
default [⇑defaultpic recopy]
fromuser
[self title: ’BitRect’ in: Rectangle new fromuser.
self saveScreenBits]
origin: origin corner: corner title: title stripheight: stripheight data: data
title: title in: rect | nStrips i strips
[origin←rect origin. corner←rect corner.
"the strip height is chosen so that each bitstring is about 2048 bytes"
stripheight←1023/((self extent x + 15)/16).
nStrips←(self extent y+stripheight-1)/stripheight.
data←Vector new: nStrips.
strips←self strips.
for⦂ i to: nStrips do⦂
[data◦i←String new: (strips◦i) bitStringLength]]
Access to parts
data [⇑data]
title [⇑title]
Rectangle Protocol
= x [⇑self≡x]
bitsOntoStream: strm | bits
[for⦂ bits from: data do⦂ [strm append: bits]]
corner←x [self growby: x-corner]
extent←x [self growby: x-self extent]
growby: change | old
[old←BitRect new origin: origin corner: corner title: title
stripheight: stripheight data: data.
self title: title in: (origin rect: corner+change).
self copyBitsFrom: old]
growto: x [self growby: x-corner]
hash [user croak] primitive: 46
height←h [self growby: 0⌾(h-self extent y)]
printon: strm
[strm append: ’a BitRect’]
width←w [self growby: (w-self extent x)⌾0]
Editing
copyBitsFrom: other
| clippedStrip i j myStrips otherStrips myStrip otherStrip
["copy all bits from other that are within my area"
myStrips←self strips. otherStrips←other strips.
for⦂ i to: myStrips length do⦂
[for⦂ j to: otherStrips length do⦂
[myStrip←myStrips◦i. otherStrip←otherStrips◦j.
clippedStrip←myStrip intersect: otherStrip.
clippedStrip empty⇒[]
BitBlt init function←0;
destbase←data◦i;
destraster←myStrip width+15/16;
dest←clippedStrip origin-myStrip origin;
extent←clippedStrip extent;
sourcebase←other data◦j;
sourceraster←otherStrip width+15/16;
source←clippedStrip origin-otherStrip origin;
checksandcall]]]
edit | a
[user leaveTop.
a←BitRectEditor new picture: self.
a takeCursor; enter.
user restartup: a]
Showing
saveScreenBits | strips i
[strips←self strips.
for⦂ i to: strips length do⦂
[strips◦i bitsIntoString: data◦i mode: storing clippedBy: nil]]
show | strips i
[strips←self strips.
for⦂ i to: strips length do⦂
[strips◦i bitsFromString: data◦i]]
strips "return a vector of strips (Rectangles)"
| nStrips strips stripOrigin stripExtent i
[(nStrips←data length)=1⇒[⇑self inVector]
strips←Vector new: nStrips.
stripOrigin←origin. stripExtent←self width⌾stripheight.
for⦂ i to: nStrips-1 do⦂
[strips◦i←Rectangle new origin: stripOrigin extent: stripExtent.
stripOrigin←stripOrigin+(0⌾stripheight)].
strips◦nStrips←Rectangle new origin: stripOrigin corner: corner.
⇑strips]
Filin and filout
filin: title | f i x y rect strips "read bits from a file"
[f←dp0 oldFile: (title concat: ’.pic.’).
f readonly.
f end⇒[f close. user notify: ’no data’]
x←f nextword. y←f nextword.
rect←Rectangle new origin: [origin is: Point⇒[origin] 0⌾0] extent: x⌾y.
self title: title in: rect.
stripheight≠f nextword⇒[user notify: ’strip heights dont match’]
strips ← self strips.
for⦂ i to: strips length do⦂
[f into: data◦i].
f close]
filout | f i "write bits on a file"
[f ← dp0 file: (title concat: ’.pic.’).
f nextword ← self extent x.
f nextword ← self extent y.
f nextword ← stripheight.
for⦂ i from: data do⦂ [f append: i].
f close]
Press
length [⇑self bitStringLength]
presson: press in: r | w h hs scale w16 y [
scale ← press scale.
h ← self height.
(hs ← scale*h) > r height⇒ [
"not enough room left on current page.
assume for now that it will at least fit on an entire page"
⇑self]
w ← self width.
w16 ← w + 15 | 16 "width to next word boundary".
"with w, prints on viola but not on spruce.
with w16, prints on spruce with garbage on end"
press setp: 0⌾(y ← r corner y - hs);
dots⦂ [
press setcoding: 1 "bitmap" dots: w16 lines: h;
setmode: 3 "to right and to bottom";
setsizewidth: scale*w16 height: hs;
setwindowwidth: w16 height: h;
dotsfollow.
self bitsOntoStream: press data].
⇑y]
SystemOrganization classify: ↪BitRect under: ’Picture Editor’.
BitRect classInit
"BitRectEditor"
Class new title: ’BitRectEditor’
subclassof: Window
fields: ’tool "<BitRectTool> the current tool"
picture "<BitRect> the picture we are working on"
dirty "false if picture has not been modified"
saveActionPic saveToolPic "buffers for saving background" ’
declare: ’tools toolpic actionbuttons actionpic windowmenu ’;
asFollows
BitRectEditor edits BitRects.
To create, say:
BitRect new fromuser edit.
This installs a BitRectEditor in the scheduler and starts it up.
The editing tools are to the left of the picture. (The first one looks like a doodle). They are: draw-thin, erase, straightedge, gray-block, paintbrush, magnifier. The actions for the tools are displayed above the picture.
See BitRectTool for explanations of the actions.
CAUTION: this ordering is arbitrary. It is currently possible to set a new action for any of the tools, so that if you are not careful, the straightedge will start being a magnifier or whatever. This should get fixed eventually.
tools = a RadioButtons. Each button owns a BitRectTool (the active one is held in tool).
actionbuttons = a Vector of RadioButtons. The groups of buttons are: action, mode, pen width, gray, and grid.
toolpic = BitRect of icons for the tools (at side of picture).
actionpic = BitRect of icons for the parts of a tool (above picture)
windowmenu = menu for bluebug.
To edit a copy of the tool picture, say
newpic←(BitRectEditor◦↪toolpic) recopy.
newpic edit.
To install this copy as the menu picture, say
BitRectEditor new toolpic: newpic recopy.
Do the analogous thing to edit the action picture.
Caution: the editor blows up if you edit the tool picture itself and not a copy.
Initialization
actionpic: a [actionpic ← a]
classInit | t i
[t ← Vector new: 6.
for⦂ i to: t length do⦂ [t◦i ← BitRectTool new init].
tools ← (RadioButtons new) vec: t at: 0⌾0 width: 20.
windowmenu ← Menu new string: ’under
move
grow
close
filout
printbits’.
actionpic←BitRect new filin: ’actionpic’.
toolpic←BitRect new filin: ’toolpic’.
self initmenu1]
initmenu1 | s z
[s ← Vector new: 5. z ← 20.
s◦1 ← (RadioButtons new) vec: ↪(setbrush paint block draw line blowup) at: 0⌾0 height: z. "action"
s◦2 ← (RadioButtons new) vec: (black, dkgray, gray, ltgray, white) at: 0⌾0 height: z. "tone"
s◦3 ← (RadioButtons new) vec: (0, 1, 2, 3) at: 0⌾0 height: z. "mode"
s◦4 ← (RadioButtons new) vec: (1, 2, 4, 8) at: 0⌾0 height: z. "width"
s◦5 ← (RadioButtons new) vec: (1, 2, 4, 8, 16, 32) at: 0⌾0 height: z. "grid"
actionbuttons ← s.]
picture: picture
[tool ← tools push: 1.
self frame: (picture origin rect: picture corner)]
toolpic: a [toolpic ← a]
Window protocol
bluebug |
[
picture is: BitImage⇒ [ ⇑ picture fromrectangle: (picture rectangle)]
windowmenu bug
=1 ⇒[self leave. ⇑exitflag ← false]; "under"
=2 ⇒[self leave; newframe; enter]; "move"
=3 ⇒[self grow "grow"];
=4 ⇒[self leave; erase. "close"
user unschedule: self. ⇑false];
=5 ⇒[self leave. picture filout. self enter]; "filout"
=6 ⇒[self print] "press file"]
enter | start pt b
["Periodically check if the mouse is still in the frame.
If not, stop showing the picture"
super show. self lostMouse⇒[⇑false]
picture show. dirty←false. self lostMouse⇒[⇑false]
for⦂ b from: actionbuttons do⦂ [b reset].
"show action menu above the picture"
start←frame origin-1.
pt ← start-(0⌾actionpic extent y).
actionpic moveto: pt.
saveActionPic←actionpic bitsIntoString.
self lostMouse⇒[⇑false]
"last point I can return before having to restore bits under menus"
actionpic show.
pt ← actionbuttons◦1 moveto: pt. "action"
pt ← actionbuttons◦3 moveto: pt. "mode"
pt ← actionbuttons◦4 moveto: pt. "width"
"show the next bank of action buttons"
pt ← start-(0⌾(actionpic extent y+1/2)).
pt ← actionbuttons◦2 moveto: pt. "tone"
pt ← actionbuttons◦5 moveto: pt. "grid"
tool brushpt: (pt ← pt+(7⌾7)).
(tool brush) moveto: pt; show.
"show the tool pic"
pt ← start-(toolpic extent x⌾0).
toolpic moveto: pt.
saveToolPic ← toolpic bitsIntoString.
toolpic show.
tools moveto: pt; setvalue: tool.
tool frame: frame; showon: actionbuttons.]
fixframe: r
[picture moveto: r origin.
r corner←picture corner.
⇑r]
grow | oldframe newframe pt r
[self leave.
newframe←picture origin rect: picture corner.
CornerCursor showwhile⦂
[pt←user mp+16.
while⦂ user nobug do⦂
[newframe corner←pt. newframe comp.
pt←user mp+16. newframe comp].
while⦂ user anybug do⦂
[newframe corner←pt. newframe comp.
pt←user mp+16. newframe comp]].
"clear unused areas from old picture to background,
and clear new picture areas to white"
oldframe←picture inset: ¬2⌾¬2. "¬2 is for erasing old border"
for⦂ r from: (oldframe minus: newframe) do⦂ [r clear: background].
for⦂ r from: (newframe minus: picture) do⦂ [r clear: white].
picture title: picture title in: newframe; saveScreenBits.
self frame: newframe; show; takeCursor; enter]
leave
[[nil≡saveActionPic⇒[]
actionpic bitsFromString: saveActionPic.
saveActionPic ← nil.].
[nil≡ saveToolPic⇒[]
toolpic bitsFromString: saveToolPic.
saveToolPic←nil].
[dirty⇒[picture saveScreenBits. dirty ← false]].
frame border: 3 color: white]
lostMouse [⇑(frame has: user mp)≡false]
outside | pt
[toolpic has: (pt←user mp)⇒
[user redbug⇒
[tool←tools bug: pt. tool frame: frame; showon: actionbuttons]]
actionpic has: pt⇒
[user redbug⇒
[tool setfrom: actionbuttons]]
⇑false]
redbug [dirty←true. tool redbug]
showtitle "The BitRectEditor have a menu where the title used to be"
title [⇑picture title]
tool [⇑ tool]
yellowbug
[picture is: BitImage⇒ [ picture yellowbug]
]
SystemOrganization classify: ↪BitRectEditor under: ’Picture Editor’.
BitRectEditor classInit
"BitRectTool"
Class new title: ’BitRectTool’
subclassof: Object
fields: ’action "<UniqueString> the current action"
pencil "<Turtle> used for draw or straight-edge"
brush "<BitRect> source for painting"
mode "<Integer> how brush combines with the destination"
tone "<Integer> a spatial half-tone color (4 bits by 4 bits)"
grid "<Integer> all mouse points are rounded to this"’
declare: ’blowupScale graypens brushpt ’;
asFollows
A BitRectTool paints on the screen.
A tool is a combination of action, mode, pen-width, gray, and grid.
action is one of: make-brush, paint, block-of-gray, draw, straight-edge, magnify.
mode is one of: store, or, xor, and. (how tool is combined with picture)
pen-width is 1, 2, 4, or 8. (width of the pen)
gray is one of: black, darkgray, gray, lightgray, white.
grid is one of: 1, 2, 4, 8, 16, 32. (minimum spacing of mouse points)
Menus for each part of a tool appear above the picture (in the same order).
Some actions do not use certain of the other parts of a tool.
(example: Block-of-gray does not use pen-width.)
brushpt = Point in the menu where brush is shown.
graypens = Vector of Strings of bits in pens.
Tool action
block [self getRectangle color: tone mode: mode]
blowup | smallRect bigRectFrame
[smallRect←self getRectangle.
bigRectFrame ← Rectangle new origin: smallRect corner
extent: 4⌾4 + (smallRect extent*blowupScale).
smallRect empty or⦂ bigRectFrame bitStringLength>4000⇒
[pencil frame flash. ⇑nil].
[user screenrect has: bigRectFrame corner⇒[]
bigRectFrame moveto: smallRect origin-bigRectFrame extent.
user screenrect has: bigRectFrame origin⇒[]
"can’t find a space for blown up image"
pencil frame flash. ⇑nil].
self blowup: smallRect to: bigRectFrame]
blowup: smallRect to: bigRectFrame
| bigRect box pt i turt flag bits
[bits ← bigRectFrame bitsIntoString.
bigRect ← bigRectFrame inset: 2⌾2.
smallRect blowup: bigRect origin by: blowupScale.
turt←Turtle init.
box ← 0⌾0 rect: (blowupScale-1)⌾(blowupScale-1).
"keep editing in blowup mode until the user presses a button
outside the big rect"
while⦂ flag do⦂
[bigRect has: (pt ← user mp)⇒
[box moveto: bigRect origin + (i ← pt-bigRect origin|blowupScale).
turt place: smallRect origin + (i/blowupScale).
user redbug⇒[box color: black mode: storing.
turt black; go: 0]
user yellowbug⇒[box color: white mode: storing.
turt white; go: 0]
user bluebug⇒[bigRect flash]]
user anybug ⇒
[(bigRect inset: ¬5⌾¬5) has: pt⇒[bigRect flash]
"quit" flag←false]].
bigRectFrame bitsFromString: bits]
brush [⇑brush]
brush: sourceRect "use the bits in the BitRect sourceRect as a brush"
| minpt maxpt pt offset
["The inner painting loop should be fast - all the extra foliage below
is to move tests outside of the inner loop"
sourceRect moveto: brushpt; show.
minpt←self frame origin.
maxpt←self frame corner-sourceRect extent.
offset←sourceRect extent/2.
"If mode is storing or oring, use brush command, otherwise blt.
Use the unclipped form of brushing and grid=1 when possible"
[mode<xoring and⦂ grid=1⇒
[while⦂ user redbug do⦂
[minpt≤(pt←user mp-offset) and⦂ pt≤maxpt⇒
[sourceRect brush: pt mode: mode color: tone]
sourceRect brush: pt mode: mode color: tone clippedBy: self frame]]
mode≥xoring and⦂ grid=1⇒
[while⦂ user redbug do⦂
[minpt≤(pt←user mp-offset) and⦂ pt≤maxpt⇒
[sourceRect blt: pt mode: mode]
sourceRect blt: pt mode: mode clippedBy: self frame]]
mode<xoring⇒ "grid is > 1"
[while⦂ user redbug do⦂
[minpt≤(pt←self mpOnGrid-offset) and⦂ pt≤maxpt⇒
[sourceRect brush: pt mode: mode color: tone]
sourceRect brush: pt mode: mode color: tone clippedBy: self frame]]
"grid is > 1 and mode≥xoring"
while⦂ user redbug do⦂
[minpt≤(pt←self mpOnGrid-offset) and⦂ pt≤maxpt⇒
[sourceRect blt: pt mode: mode]
sourceRect blt: pt mode: mode clippedBy: self frame]].
]
draw
[tone=white or⦂ tone=black⇒
[pencil place: self mpOnGrid-pencil frame origin.
grid=1⇒ "make drawing with grid 1 fast"
[while⦂ user redbug do⦂
[pencil goto: user mp-pencil frame origin]]
while⦂ user redbug do⦂
[pencil goto: self mpOnGrid-pencil frame origin]]
self brush: graypens◦pencil width]
getRectangle | rect newrect start t "rect must be in my frame"
["the rect-newrect stuff is so that the complementing stays
on for a while"
start←self mpOnGrid.
rect←newrect←(Rectangle new origin: start corner: start)
intersect: self frame.
"move the cursor slightly so that the user will notice the rectangle
being complemented"
user cursorloc←start+4.
while⦂ user anybug do⦂
[rect←newrect.
rect comp.
t←self mpOnGrid.
newrect←(Rectangle new origin: (start min: t) corner: (start max: t))
intersect: self frame.
rect comp].
⇑rect]
line | start end width
[start←end←self mpOnGrid-pencil frame origin.
width←pencil width. pencil xor; width: 1.
while⦂ user redbug do⦂
[end←self mpOnGrid-pencil frame origin.
pencil xor; place: start; goto: end; place: start; goto: end].
[tone=white⇒[pencil white] pencil black].
pencil width: width; place: start; goto: end]
mode
[⇑ mode]
mpOnGrid "return mouse point rounded to grid"
[⇑user mp+(grid/2) | grid]
paint
[self brush: brush]
redbug [self perform: action]
setbrush | rect
[rect←self getRectangle.
rect empty or⦂ 50⌾50<rect extent⇒[pencil frame flash].
brush color: white mode: storing.
brush title: ’brush’ in: rect; saveScreenBits.
brush moveto: brushpt; show.
action ← ↪paint]
shade | p1 p2 a b t p r vs "down on redbug is black place.
up on redbug is white place. Subsequent redbugs
paint a shade of gray depending on position between
black and white (and beyond white to black again).
Yellow or blue bug terminates."
[until⦂ user redbug do⦂ [p1 ← user mp]. "black"
until⦂ user nobug do⦂ [p2 ← user mp]. "white"
vs ← ↪( ¬1 ¬1025 ¬1089 ¬585 ¬4681 ¬6731 ¬22058 ¬27031 ¬26986 ¬31191 ¬32108 5160 5128 8321 1025 01 0).
r ← 0⌾0 rect: 10⌾10.
b←(p1-p2). b ← b x asFloat ⌾ b y asFloat.
a ← b x * b x + (b y * b y) /16.0.
until⦂ (user yellowbug or⦂ user bluebug) do⦂
[user redbug ⇒[p←user mp.
t ← b* (p-p2).
t ← (t x + t y /a) asInteger abs min: 16.
brush brush: p mode: mode color: vs◦(17-t)]
]
]
tone
[⇑ tone]
Tool selection
brushpt: pt "set the point at which the current brush will be shown"
[brushpt←pt]
frame [⇑pencil frame]
frame: f [pencil frame: f]
setfrom: butvec | pt
[butvec◦1 has: (pt ← user mp) ⇒
[action ← butvec◦1 bug: pt]
butvec◦2 has: pt ⇒[tone ← butvec◦2 bug: pt.
tone=white ⇒[pencil white] pencil black]
butvec◦3 has: pt ⇒[mode ← butvec◦3 bug: pt]
butvec◦4 has: pt ⇒[pencil width: (butvec◦4 bug: pt)]
butvec◦5 has: pt ⇒[grid ← butvec◦5 bug: pt]
]
showon: butvec
[butvec◦1 setvalue: action.
butvec◦2 setvalue: tone.
butvec◦3 setvalue: mode.
butvec◦4 setvalue: pencil width.
butvec◦5 setvalue: grid]
Class initialization
classInit | rect saveBits t i
[blowupScale←4.
"make a vector of gray pens"
rect ← 0⌾0 rect: 9⌾9.
saveBits←rect bitsIntoString.
t ← Turtle init.
graypens ← Vector new: 8.
for⦂ i to: 8 do⦂
[t width: i.
rect clear: white.
t place: 4⌾4; go: 0.
graypens◦i ← BitRect new title: ’graypen’ in: rect.
(graypens◦i) saveScreenBits].
rect bitsFromString: saveBits]
init
[(pencil ← Turtle new) init; black; width: 2.
(brush ← BitRect new) title: ’brush’ in: (0⌾0 rect: 16⌾16).
tone ← black. mode ← 0. grid ← 1. action ← ↪draw]
SystemOrganization classify: ↪BitRectTool under: ’Picture Editor’.
BitRectTool classInit
"RadioButtons"
Class new title: ’RadioButtons’
subclassof: Object
fields: ’vec "<Vector> values corresponding to the buttons"
cur "<Integer> button currently selected"
rect "<Rectangle> contains all the buttons"
size "<Integer> width or height of a button"’
declare: ’’;
asFollows
A RadioButtons is a row or column of square regions ("buttons") on the display screen. There is always exactly one button pushed. (RadioButtons is a model of the station selection buttons on a car radio.) The pushed button has a black box around it. Each button has a value associated with it, which is returned when the button is pressed. RadioButtons will not destroy a menu picture (BitRect) displayed in its area, but the RadioButtons has no knowledge of the picture.
Pushing a Button
bug: pt | r a
[r ← (pt - rect origin - (1⌾1)) / size.
a ← r x + r y + 1.
⇑self push: a]
push: a
[self release: cur thenPush: a.
⇑vec◦(cur ← a)]
setvalue: v | i
["if value has been lost, set self to 1"
i←(vec find: v) max: 1.
self push: i. ⇑i]
Init and State
has: pt [⇑rect has: pt]
moveto: pt
[rect moveto: pt.
cur ← 0.
⇑rect corner x ⌾ rect origin y]
reset [cur←0]
value [⇑vec◦cur]
vec [⇑vec]
vec: vec at: r height: size
[rect ← r rect: r+ ((vec length ⌾ 1)*size).
cur ← 0]
vec: vec at: r width: size
[rect ← r rect: r+ ((1 ⌾ vec length)*size).
cur ← 0]
Private
release: a thenPush: b | boxer offset
[a=b⇒[]
offset ← [size=rect extent y⇒[size⌾0] 0⌾size].
[a≠0⇒[boxer ← Rectangle new origin: (offset*(a-1)+rect origin+1)
extent: size⌾size-1. boxer comp. (boxer inset: 1⌾1) comp]].
b≠0⇒[boxer ← Rectangle new origin: (offset*(b-1)+rect origin+1)
extent: size⌾size-1. boxer comp. (boxer inset: 1⌾1) comp]]
SystemOrganization classify: ↪RadioButtons under: ’Picture Editor’.