0005-Graphical-Objects.st

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

"Cursor" 
Class new title: 'Cursor'
	subclassof: Object
	fields: 'bitstr offset'
	declare: '';
	asFollows 

I am a 16 x 16 dot matrix suitable for use as the Alto hardware cursor

Initialization 
fromString: bitstr [self fromString: bitstr offset: 0⌾0]
fromString: bitstr offset: offset
fromtext: str [self fromtext: str offset: 0⌾0]
fromtext: str offset: offset | i s n c [
	"Not great, but compatible with printon."
	bitstr ← String new: 32.
	s ← str asStream.  s next.
	for⦂ i to: 16 do⦂
		[n ← 0.
		while⦂ ((c ← s next)=060 or⦂ c=061) do⦂
			[n ← (n lshift: 1)+(c-060)].
		bitstr word: i ← n]]
offset: offset

Hardware cursor 
frompage1		"load this cursor from the hardware locations"
	[bitstr ← String new: 32.
	BitBlt new forCursor; sourcebase← 0431; destbase ← bitstr; copy: storing]

Conversion 
hardcopy: pf ["use current cursor position"
	self hardcopy: pf at: user mp - offset]
hardcopy: pf at: loc | rect [
	"print cursor image at some point location into a presssfile"
	rect ← loc extent: 16⌾16.
	pf setp: (pf transrect: rect) origin; bitmap: rect bits: bitstr]
printon: strm | i
	[strm append: 'Cursor new fromtext: '''.
	for⦂ i to: 16 do⦂
		[strm cr.
		(bitstr word: i) printon: strm base: 2]
	strm append: ''' offset: '; print: offset; append: '.']

Aspects 
offset [⇑offset]

Showing 
show	 [
	"copy this cursor into the page 1 hardware locations"
	BitBlt new forCursor; destbase← 0431; sourcebase ← bitstr; copy: storing.
	user currentCursor: self

	"the following statement will copy back if we ever need to"
	"BitBlt new forCursor; sourcebase← 0431; destbase ← bitstr; copy: storing"]
showwhile⦂ expr | oldcursor value [
	oldcursor ← user currentCursor.
	self show.
	value ← expr eval.
	oldcursor show.
	⇑value]

Compatibility 
topage1	[self show]

SystemOrganization classify: ↪Cursor under: 'Graphical Objects'.

"HalfToner" 
Class new title: 'HalfToner'
	subclassof: Object
	fields: 'lines pixelsPerLine black white errorString rect vect inpix outpix nlines npix strm inset'
	declare: '';
	asFollows 

This class converts ais image files to screen bits

AIS to Bits 
decode: str using: s | i j k x cascadeRight cascadeDiag val error r msk masks
	["Change 8-bit grey from str filling s"
	 masks←↪(128 64 32 16 8 4 2 1).
	 cascadeRight←0.
	 cascadeDiag←errorString◦1.
	 i←msk←j←k←1. x←0-outpix.
	 s◦1←0.
	 for⦂ i to: pixelsPerLine do⦂
		[while⦂ x<0 do⦂
			[val←(str◦i)-black.
			[(error←cascadeRight-val)≥0⇒
				["print Black" s◦j←masks◦msk+(s◦j). (error>white)⇒[error←white] ]
				"print White" (error←error+white)<0⇒[error←0] ].
			error←error/2.
			val←error/2.
			errorString◦k←cascadeDiag+val.
			cascadeRight←errorString◦(k+1)+error.
			cascadeDiag←val.
			[(msk←msk+1)>8⇒[msk←1. j←j+1. s◦j←0] ].
			x←x+inpix. k←k+1].
		x←x-outpix].
	⇑s]  primitive: 109
doFile | str i s2 r y skipsum
	[str←String new: pixelsPerLine.
	r←0⌾0 rect: (pixelsPerLine*outpix/inpix)⌾1. r moveto: rect origin copy.
	s2←String new: 1+((pixelsPerLine*outpix)/(8*inpix)).
	vect←Vector new: lines. strm reset; position←2048+(inset y*npix). "crop top"
	i←1. y←0-outpix. skipsum←0.
	while⦂ i≤lines do⦂
		[skipsum←skipsum+inset x. "inset left"
		strm skip: skipsum. skipsum←0. "do all tallied skips prior to next read"
		strm into: str endError: true.
		r bitsFromString: (self decode: str using: s2).
		skipsum←skipsum+npix-(pixelsPerLine+inset x).
		r origin y←r origin y+1. r corner y←r corner y+1.
		[(y←y+inpix)≥0⇒ "next line?"
			[i←i+1. y←y-outpix.
			while⦂ (y≥0 and⦂ i≤lines) do⦂ [i←i+1. y←y-outpix. skipsum←skipsum+npix] ]
			skipsum←skipsum-npix] ]. "not next line"
	strm close]
intoPress: p file: f | outrect "Creates an external file reference"
	[outrect←p transrect: rect.
	p setp: (outrect origin); dots⦂
		[p setcoding: 8 "byte samples" dots: npix lines: nlines;
		setmode: 3 "to right and to bottom of page";
		setwindowwidth: pixelsPerLine height: lines
			skipdots: (inset x) skiplines: (inset y);
		setsizewidth: (outrect width) height: (outrect height);
		dotsfromAIS: f] ]
"
	|p. p←dp0 pressfile: 'pix.press'.
	p pictureinit. (HalfToner new test) intoPress: p file: 'Rolfup.AIS'. p close.
"
setup | i r1 r2 inset done"set up default paramsHalfToner new doFile."
	[user print: 'Black? (0-255)'. black ← user read asVector◦1.
	 user print: 'White? (0-255)'. white ← user read asVector◦1.
	 white ← white-black max: 255.
	 [white>255⇒[white ← 255]].
	 r1 ← 0⌾0 rect: pixelsPerLine⌾lines. 
	 user print: 'Position whole '.
	 until⦂ user anybug do⦂ [r1 moveto: user mp. r1 comp. r1 comp].
	 user waitnobug. r1 comp. "show whole"
	 user print: ' Show cropping '.
	 r2 ← Rectangle new fromuser intersect: r1. r1 comp.
	 inset ← r2 origin - r1 origin. 
	 pixelsPerLine ← pixelsPerLine min: r2 width.
	 lines ← lines min: r2 height.
	 done ← false.
	until⦂ done do⦂
	 [user print: ' Position it '.
	 rect ← Rectangle new fromuser.
	 [rect width>r2 width⇒["blowup" inpix ← 8. outpix ← (8*rect width/r2 width)]
		"shrink" outpix ← 8. inpix ← (8*r2 width/rect width)].
	 rect extent ← r2 extent * outpix / inpix.
	 rect comp. user print: 'ok? (redbug)'.
	 until⦂ user anybug do⦂ []. [user redbug⇒[done ← true]]. user waitnobug.
	 rect comp].
	 errorString ← String new: pixelsPerLine*outpix / inpix+1.
	 for⦂ i to: errorString length do⦂ [errorString◦i ← 0].
	 ⇑inset "return inset"
	]

Init/Access 
nlines [⇑nlines]
npix [⇑npix]
rect [⇑rect]
rect←rect
setup: strm | inrect croprect
	[strm readonly.
	(strm word: 2)≠1024 or⦂ (strm word: 9)≠8⇒[user notify: 'bad file']
	nlines←lines←strm word: 4. npix←pixelsPerLine←strm nextword.
	black←0. white←255.
	inrect←0⌾0 rect: pixelsPerLine⌾lines. inrect moveto: rect origin.
	inrect usermove; comp. "show whole"
	croprect←rect copy. croprect moveto: inrect origin copy. croprect maxstretch: inrect.
	croprect userstretch: inrect. inrect comp.
	inset←croprect origin-inrect origin.
	pixelsPerLine←croprect width. lines←pixelsPerLine*rect height/rect width.
	[rect width>pixelsPerLine⇒
		["blowup" inpix←32. outpix←(32*rect width/pixelsPerLine)]
		"shrink" outpix←32. inpix←(32*pixelsPerLine/rect width)].
	errorString←String new: pixelsPerLine*outpix/inpix+2.
	errorString all←0]
strm [⇑strm]
test | files
	[files←(dp0 filesMatching: '*.ais.') sort.
	files empty⇒[user notify: 'no .ais files on disk']
	strm←dp0 file: (files◦(Menu new stringFromVector: files) zbug). strm readonly.
	rect←Rectangle new usersize. self setup: strm; doFile]
"
HalfToner new test.
"

SystemOrganization classify: ↪HalfToner under: 'Graphical Objects'.

"Turtle" 
Class new title: 'Turtle'
	subclassof: Object
	fields: 'pen ink width dir x xf y yf frame'
	declare: '';
	asFollows 

Turtles can crawl around the screen drawing and printing at any angle.
Dont forget to send them the message init before any drawing commands.

Initialization 
erase
	[frame clear: white]
frame [⇑frame]
frame: frame
init
	[pen ← width ← 1.
	x← y← xf← yf← 0.
	frame ← user screenrect.
	self black; home]

Pen Control 
black [ink ← black]
color: ignored  "Only implemented for PressTurtle"
ink: ink
pen: pen
pendn
	[pen ← 1]
penup
	[pen ← 0]
white [ink ← white]
width [⇑width]
width: width
xor [ink ← 2]

Drawing 
fillIn⦂ expr [⇑expr eval]  "Only implemented for PressTurtle"
go: length [user croak] primitive: 53
goto: pt
	[pt x is: Integer⇒[user croak]
	self goto: pt x asInteger⌾pt y asInteger] primitive: 54
home		
	[self up; place: frame center-frame origin. xf← yf← 0100000]
place [⇑x⌾y]
place: pt | p
	[p← pen. pen← 0. self goto: pt. pen← p]
pointAt: pt | diff "change direction so turtle points at pt."
	[diff ← (pt - (self place)).
	 dir ← ((diff theta) asInteger)]


stretchto: pt | t old
	[t ← Turtle init frame: frame. old ← x⌾y. 
	t xor; place: old; goto: pt; place: old; goto: pt]
turn: angle
	[dir← dir+angle\360]
up	 [dir ← 270]		"Point toward top of screen"


Text 
put: char font: font		"char=ascii Integer, font=font bits (String)"
	[user croak] primitive: 56
show: str font: font | a f		"str=text (String), font=font number (0-9)"
	[f← DefaultTextStyle fonts◦(font+1).
	for⦂ a from: str do⦂
		[self put: a font: f]]

Examples 
dragon: n
	[n=0⇒[self go: 10]
	n>0⇒[self dragon: n-1; turn: 90; dragon: 1-n]
			self dragon: ¬1-n; turn: ¬90; dragon: 1+n]
"
Turtle init dragon: 8
"
filberts: order side: s | i n2
	[n2← 1 lshift: order-1.
	self penup; go: 0-n2*s; pendn.
	for⦂ i to: 4 do⦂
		[self color: i-1*40.
		self fillIn⦂ [self hilbert: order side: s; go: s; hilbert: order side: s; go: s].
				self black; hilbert: order side: s; go: s; hilbert: order side: s; go: s.
		self penup; go: n2-1*s; turn: ¬90; go: n2*s; turn: 180; pendn]]
"
Turtle init erase filberts: 3 side: 10.

user displayoffwhile⦂
	[PressTurtle new init: 'try.press'; filberts: 4 side: 10; close].
"
hilbert: n side: s | a m
	[n=0⇒[self turn: 180]
	[n>0⇒[a←90. m←n-1] a←¬90. m←n+1].
	self turn: a; hilbert: 0-m side: s; turn: a.
	self go: s; hilbert: m side: s;
		turn: 0-a; go: s; turn: 0-a;
		hilbert: m side: s; go: s.
	self turn: a; hilbert: 0-m side: s; turn: a]
"
Turtle init hilbert: 3 side: 4
"

hilberts: n | i s
	[self penup; go: 128; pendn.
	for⦂ i to: n do⦂
		[s← 256 lshift: 0-i.  self color: n-i*40; width: n-i+1.
		self penup; go: 0-s/2; turn: ¬90; go: s/2; turn: 90; pendn.
		self hilbert: i side: s; go: s; hilbert: i side: s; go: s]]
"
Turtle init erase hilberts: 5.

user displayoffwhile⦂
	[PressTurtle new init: 'try2.press'; hilberts: 4; close].
"
mandala: npoints diameter: d | l points i j
	[l← (3.14*d/npoints) asInteger.
	self home; penup; turn: ¬90; go: d/2; turn: 90; go: 0-l/2.
	points← Vector new: npoints.
	for⦂ i to: npoints do⦂
		[points◦i← self place.
		self go: l; turn: 360/npoints].
	self pendn.
	for⦂ i from: npoints/2 to: 1 by: ¬1 do⦂
		[self color: (npoints/2)-i*20\250.
		for⦂ j to: npoints do⦂
			[self place: points◦j; goto: points◦(j+i-1\npoints+1)]]]
"
Turtle init mandala: 30 diameter: 400

user displayoffwhile⦂
	[PressTurtle new init: 'try.press'; mandala: 30 diameter: 500; close.]
"
spiral: n angle: a | i
	[for⦂ i to: n do⦂
		[self color: i*2\256; go: i; turn: a]]
"
 Turtle init spiral: 200 angle: 89; home; spiral: 200 angle: ¬89.

 user displayoffwhile⦂ [(PressTurtle new init: 'try.press')
		spiral: 403 angle: 89;
		home; spiral: 403 angle: ¬89; close.]
 "

SystemOrganization classify: ↪Turtle under: 'Graphical Objects'.

"PressTurtle" 
Class new title: 'PressTurtle'
	subclassof: Turtle
	fields: 'file fplace fdir filling'
	declare: '';
	asFollows 

I work with Pressfile to print high resolution pictures.
All inputs can be floating point for high resolution.
Complexity is limited to about 2k lines until multiple entity lists

Initialization 
close [file page. file close]
init: name 
	[file ← (dp0 pressfile: name).
	filling← false.
	file pictureinit. self black.
	super init]
initwithfile: name 
	[file ← name.
	filling← false.
	self black.
	super init]

Pen Control 
black 
	[file brightness: 0. super black]
blue [self color: 160]
color: h [file hue: h; brightness: 255; saturation: 255]
cyan [self color: 120]
green [self color: 80]
magenta [self color: 200]
place [⇑fplace]
red [self color: 0]
up [dir← 270. fdir← 270.0]
white 
	[file brightness: 255.
	file saturation: 0.
	super white]
yellow [self color: 40]

Drawing 
fillIn⦂ expr		"Code in expr must describe a closed figure"
	[filling← true.
	file object⦂ expr eval atScreen: fplace.
	filling← false]
go: dist | old
	[self goto: fplace + 
		(([fdir\90.0=0.0⇒		"optimize horiz and vert lines"
			[fdir/90.0=0⇒[1.0⌾0.0];
						=1⇒[0.0⌾1.0];
						=2⇒[¬1.0⌾0.0];
						=3⇒[0.0⌾¬1.0]]
		fdir asRadians asDirection])*dist)]
goto: p | old
	[old← fplace.
	fplace ← p x asFloat ⌾ p y asFloat.
	super goto: fplace x round ⌾ fplace y round.
	filling⇒[file objectGotoScreen: fplace pen: pen]
	pen=1⇒[file drawlinefromscreen: old to: fplace width: 0.46875*width]]
turn: angle [fdir← fdir+angle\360.0]

SystemOrganization classify: ↪PressTurtle under: 'Graphical Objects'.