’From Smalltalk 5.5bXM July 4 on 1 August 1979 at 9:42:34 am.’
̃
"Aurora"
Class new title: ’Aurora’
subclassof: Object
fields: ’source destination function figure ground
transparentground constantregister spareone sparetwo sparethree’
declare: ’DoverB Aonly Bonly aureadloc Noop AoverB AtransoverB AtransstoreB auwriteloc Conly Donly DstoreB auselloc Setcolor CstoreB pmscreenrect CoverB AstoreB ’;
asFollows̃
This class has not yet been commented
INIT
classInit
["specify i/o words"
auselloc ← 0177410.
auwriteloc ← 0177411.
aureadloc ← 0177412.
pmscreenrect ← (00̆) rect: (6404̆80).
mem‘auselloc ← 014000.
mem‘auwriteloc ← 010.
AstoreB← 002117. "alto stream into pm"
CstoreB← 000117. "stores figure color block into pm"
DstoreB← 000517. "a/d output into pm"
AoverB← 002103. "alto stream over pm"
CoverB← 000103. "figure color block over pm"
DoverB← 000503. "a/d output over pm"
AtransoverB← 012103. "ground transparent"
AtransstoreB← 012117. "ground transparent"
Noop← 0.
]
ACCESS TO PARTS
destination: destination
figure: figure
function: function
ground: ground
source: source
PRIMITIVE ACCESS
disabledatatransfer
[
mem‘auselloc ← 014000."DDT"
mem‘auwriteloc ← 012.
]
doit "primitive call to Aurora"
[
"self waitverticalinterval: 1 ;
disabledatatransfer ;
setsourcewin ;
setrasterwin ;
setfigureground ;
setfunc ;
enabledatatransfer ;
waitverticalinterval: 1."
user croak
] primitive: 105
enabledatatransfer
[
mem‘auselloc ← 014000."EDT"
mem‘auwriteloc← 010.
mem‘auselloc← 0.
]
setconst
["sets the constant register "
mem‘auselloc ← 014000."WCReg ← c"
mem‘auwriteloc ← 0263.
mem‘auwriteloc ← 0400 + constantregister.
]
setfigureground
["sets the figure and ground registers "
mem‘auselloc ← 014000."set figure"
mem‘auwriteloc ← 0263.
mem‘auwriteloc ← 0400 + figure.
mem‘auselloc ← 014000."set ground"
mem‘auwriteloc ← 0267.
mem‘auwriteloc ← 0400 + ground.
]
setfunc
[
mem‘auselloc ← 014000."sets the inmode register "
mem‘auwriteloc ← 0261.
mem‘auwriteloc ← (function lshift: 0-8) + 0400.
mem‘auselloc ← 014000."sets the op register"
mem‘auwriteloc ← 0262.
mem‘auwriteloc ← (function land: 0377) + 0400.
]
setpmcolortable: colordef
["sets the color table in the picture memory.
self waitverticalinterval: 1.
self disabledatatransfer.
mem‘auselloc ← 014000.
mem‘auwriteloc ← 0271.
mem‘auwriteloc ← 0400 + colordef value.
mem‘auwriteloc ← 0400 + colordef red.
mem‘auwriteloc ← 0400 + colordef green.
mem‘auwriteloc ← 0400 + colordef blue.
self enabledatatransfer."
user croak
] primitive: 106
setrasterwin | r
["sets the destination window"
r ← destination intersect: pmscreenrect.
r empty []
mem‘auselloc ← 010000.
mem‘auwriteloc ← r leftside +110.
mem‘auselloc ← 010002.
mem‘auwriteloc ← (r top)/2 + 21.
mem‘auselloc ← 010001.
mem‘auwriteloc ← r width.
mem‘auselloc ← 010003.
mem‘auwriteloc ← (r height)/2 - 1.
]
setsourcewin"set alto source window for aurora"
[
mem‘auselloc ← 020000.
mem‘auwriteloc ← mem‘066. "starting memory address of bit map BCA goes here"
mem‘auselloc ← 020001.
mem‘auwriteloc ← (user screenrect width +15 )/16. " bit maps width in words BMR".
mem‘auselloc ← 020002.
mem‘auwriteloc ← (source width +15) /16. " source width in words"
mem‘auselloc ← 020003.
mem‘auwriteloc ← source height.
mem‘auselloc ← 020010.
mem‘auwriteloc ← 0261." format ... wrap in both x and y and one bit per point."
]
waitverticalinterval: n | i"wait for n vertical intervals"
["forç i to: n doç
[
untilç ((mem‘aureadloc) land: 1) = 1 doç []
]"
]
UTILITIES
black | r c i
[
self standardcolortable.
r ← user screenrect.
user displayoffwhileç [
self source: r ;
destination: r;
figure: 1;
ground: 0;
function: CstoreB;
doit. self function: Noop ; doit.]
]
set: vec | c
[
c ← Colordef new.
c value: (vec‘1) ; red: (vec‘2) ; green: (vec‘3) ; blue: (vec‘4).
self setpmcolortable: c.
]
standardcolortable | c i
[
c ← Colordef new.
self set: (0 255 255 255).
self set: (1 0 0 0).
self set: (2 255 0 0).
self set: (3 192 0 64).
self set: (4 128 0 128).
self set: (5 64 0 192).
self set: (6 0 0 255).
self set: (7 0 64 192).
self set: (8 0 128 128).
self set: (9 0 192 64).
self set: (10 0 255 0).
self set: (11 64 192 0).
self set: (12 128 128 0).
self set: (13 192 64 0).
forç i from: (14 to: 255) doç
[c value: i ; red: i ; green: i ; blue: i.
self setpmcolortable: c.]
]
test | r c i
[
r ← Rectangle new fromuser.
user displayoffwhileç [
self source: r ;
destination: r;
figure: 1;
ground: 0;
function: AstoreB;
doit. self function: Noop ; doit.]
]
white | r c i
[
self standardcolortable.
r ← user screenrect.
user displayoffwhileç [
self source: r ;
destination: r;
figure: 0;
ground: 0;
function: CstoreB;
doit. self function: Noop ; doit.]
]
DEBUGGING
̃
SystemOrganization classify: Aurora under: ’Aurora’.̃
Aurora classInit̃
"Colordef"
Class new title: ’Colordef’
subclassof: Object
fields: ’value red green blue’
declare: ’’;
asFollows̃
This class has not yet been commented
INIT
value: value red: red green: green blue: blue |
[
]
ACCESS
blue
[ ffi blue ]
blue: blue
green
[ ffi green ]
green: green
red
[ ffi red ]
red: red
value
[ ffi value ]
value: value
̃
SystemOrganization classify: Colordef under: ’Aurora’.̃