Download 1 - DSpace@MIT

SOFTWARE TOOLS FOR THE GRAPHIC
DESIGNER
by
Nardy Henigan
B.F.A.,
M.A.,
Northern Illinois University
DeKalb, Illinois
June, 1977
Northern Illinois University
DeKalb, Illinois
August, 1978
Submitted to the Department of Architecture
in partial fulfillment of the requirement of the
Degree of Master of Science in Visual Studies
at the Massachusetts Institute of Technology
June, 1983
Nardy Henigan 1983
The author hereby grants to M.I.T.
permission to reproduce and to distribute copies
of this thesis document in whole or in part.
Signature of Author
N_
__
_
_
hI
Certified by
_
_
__
_
ture, May 5, 1983
k
Associate Prof ssor of Visiua
Thesis Supervisor
Accepted byI
Nicq1olas Negro]Sonte, Chair
Departmental Committee for
Graduate Students
MASSACHUSETTS INSTliUTr:
OF TECHNOLOGY
AUG
5 1983
LIBRARIES
rtiL
es
2
SOFTWARE TOOLS FOR THE GRAPHIC
DESIGNER
by
Nardy Henigan
Submitted to the Department of Archtecture on May 5, 1983,
in partial fulfillment of the requirements for the Degree of
Master of Science in Visual Studies
Abstract
This thesis describes three packages of programs of
interest to the graphic designers: (1) a tool for pointing
at objects on the display monitor, (2) a tool for
organizing sets of programs into interactive menus, and
(3) a tool for digitizing type fonts.
The graphic designer at the computer uses at least three
spaces at once: the page he is designing, the device space
of the display monitor, and the device space of the
graphics tablet.
The first tool figures the transforms
necessary to map one space into another. This allows the
user to point at a location on the tablet and thereby
identify corresponding points on the screen and in
user-defined space.
Interactive page layout requires the orchestration of
large numbers of separate procedures.
Choosing
between these procedures can be made easier for the
user if he is presented with a menu of options when a
decision is required.
The second tool is a package of
programs to help the programmer create and manage
simple or complex menus.
Simulating type on a monitor requires digitized fonts.
The third tool is a package of programs which extracts
the edge of a letterform image in the frame buffer and
stores it as a chain code.
Thesis supervisor:
Muriel Cooper
Title: Associate Professor of Visual Studies
3
CONTENTS
1.
Introduction / page 5
1.
Software tools
1.
2.
3.
4.
2.
Pointing and mapping / page 11
1.
2.
3.
3.
"Programmes for solutions"
Presummary
Method of explication
computing environment
Menus
1.
2.
3.
4.
The ideas
1.
2.
World and device space
Ports and windows
3.
Zoom facility
The map package: a user manual
1.
Introduction
2.
The map$ procedures
Further work
/
page 32
The ideas
1.
Requirements for interactive graphics
2.
Definition of a menu
3.
Visual format
The menu package: a user manual
1.
The menu text file
2.
The menu outline
3.
Prompts
4.
Ports
5.
Options
6.
Making the menu program
The use package: a user manual
1.
Using the menu data segment
2.
Use of space
3.
Communication between programs
Further work
4
4.
Type digitization /
1.
2.
The ideas
1.
Type digitization techniques
2.
An edge-detecting
3.
Chain coding
5.
routine
4.
Alternative chain coding routine
The contour package: a user manual
1.
2.
3.
page 53
Description of the font gun
Setup to digitize a font
3.
Capturing the characters
Further work
Conclusion / page 68
References
/
page 71
Acknowledgements /
page 73
Appendix I:
Source code for map package / page 75
Appendix II:
Source code for the menu package
Appendix III:
Model menu /
Appendix IV:
Source code for use package
Appendix V:
Source code for contour package /
/
page
page
1141
104
page 135
/
page 170
5
1
INTRODUCTION
6
1.1
1.1.1
SOFTWARE TOOLS
"Programmes for solutions"
The arrival
of the
workstation --
computer at the graphic designer's
or the arrival of the graphic designer at
the computer workstation --
recalls a statement by Karl
Gerstner, a Swiss graphic designer, who advocated
of solutions
for problems, programmes
He proposed that graphic designers
the design process
Gerstner's
"instead
for solutions."
El]
focus their efforts on
rather than directly on final solutions.
"programmes" were not computer programs, but
were general methods
for approaching visual problems, and
systematically generating alternative
solutions.
However
he anticipated the role of a growing number of graphic
designers who need to express their methodology as computer
code.
1.1.2
This
Presummary
thesis describes three packages of programs of
interest to the graphic designers:
(1)
a tool
for
7
communicating
with the
computer by pointing,
(2)
a
tool
for
organizing sets of programs into interactive menus, and
(3)
a tool for digitizing type fonts.
1.1.2.1
The graphic designer at
three different spaces:
the computer uses at
the space of the page he
least
is
designing, the device space of the display monitor, and the
device space of the graphics tablet. The first tool figures
the transformations
This
necessary to map one space into another.
allows the user to point at a
location on the tablet
and thereby identify corresponding points on the screen and
in the user-defined space.
1.1.2.2
Interactive page
of large numbers
layout requires the orchestration
of separate procedures.
Choosing between
these procedures can be made easier for the
user if he
is
presented with a menu of options when a decision is
required.
The
second tool is
a package of programs to help
the programmer create and manage
1.1.2.3
simple or complex menus.
Simulating type on a monitor requires digitized
fonts. The third tool
is a package of programs which
extracts the edge of a letterform image
and
stores
it
as a chain code.
in the frame buffer
8
1.1.3
Method
of explication
Each software tool is presented and developed according to
the following plan.
1.1.3.1
Problem description.
The presentation of each
software tool begins with the description of a problem of
interest to graphic designer/programmers.
this is a
I explain why
significant problem, what are the constituent
parts of the problem, and what are the current ways of
treating it both in software and hardware.
general concepts, formulas and algorithms
I discuss
the
involved in the
solution, and compare and contrast my solution with
alternative methods.
1.1.3.2
of the
Program documentation.
A working implementation
software tool is documented. A users manual is
presented for a package of pl/1 programs on the MagicSix
operating system at the Visible Language Workshop.
Complete debugged pl/1 source code
the appendix.
listings are included in
9
1.1.3.3
Evaluation and
further work.
I discuss
the
currently implemented programs with respect to completeness,
robustness, consistency, and other observed weaknesses
strengths.
I discuss ways of increasing speed of execution
and reducing storage, since space and time are always
premium.
at a
In addition, I suggest ways of making the code
more more machine-,
makes
and
system-, and language-independent. This
the packages easier to fix and maintain, accomodates
growth and change, and makes
it easier to move the packages
to other computers.
1.1.4
1.1.4.1
Computing environment
Hardware.
At the outset a general overview of the
system will be helpful.
The Perkin-Elmer 3220 is a
minicomputer with 512K of core memory. Disk
300 megabyte
Peripherals
32-bit
storage is a
"trident-type" drive with a high I/O bandwidth.
include: a Grinnell GMR-270
frame buffer with a
capacity of 512 x 512 pixels with 27 bits of color
information, a Vidicon surveillance camera which
feeds
non-composite video signals to the frame buffer, and a
Summagraphics Bit Pad tablet with a 4-button puck.
10
1.1.4.2
Software.
The MagicSix operating system,
developed by the Architecture Machine
supports an interactive computing
include
a tree-structured
a process
PL/1,
stack.
The pl/1
Group at M.I.T.,
environment.
file system, dynamic linking, and
language, a subset of standard
was also developed by the Architecture Machine Group.
It supports recursion, pointers,
structures,
error-handling, and "initiated segments,"
user
Features
to structure core memory.
signals,
which allow the
11
2
POINTING AND MAPPING
12
2.1
2.1.1
THE IDEAS
World and device space
I
I
I
+ cursor
I
position J
window
I
I
I
screen
I world
(a simplified diagram
+ puck
position
tablet
2.1.1.1
of screen, tablet, and
world spaces)
|
The designer of graphics programs deals with at
least three different kinds of spaces.
interest in
page, a
"world space:"
examples are
"window" of
an 8 1/2
two-page spread, a business card, a box car,
integer grid, or a
screen:
some
(1) A
floating point slider.
(2)
x 11
an
A display
composed of discrete pixels, numbered as positive
first quadrant of a Cartesian coordinate
integers
in the
system.
The screen is used to model world space.
graphics tablet:
(3) A
which senses the position of a puck on a
13
grid of charged wires and which returns positive
integers. The tablet is
(x,y)
used to model of both world and
screen space.
2.1.1.2
As the puck is
moved about on
the tablet,
the
corresponding screen position can be determined with a
mapping transform, and a mark such as a cursor can be
displayed nondestructively at that point.
this manner
"point" at images on the
The user can in
screen and at objects
in world space.
2.1.1.3
In some applications, such as
"painting" and
picture-making systems, the world window is
identical to
the display screen. But in the case of page layout, the
window is the page being designed, and neither
size
of the
screen,
nor do page units
picas) align with pixel boundries.
(e.g.,
is it the
points
and
14
2.1.2
Ports
and windows
I port
| window
screen
|
port
----------
I
|
|
|
|
|
I
world space
(ports
and windows, and
their relation to world
and device space)
||
tablet
2.1.2.1
space,
The window is a subset of all points in world
and the user may likewise establish a
screen or tablet which
points
term
"port" on the
is a subset of all the addressable
in the device space. The reader should note that the
"window"
"port" is
used
is
used
in
reference
to world
in reference to device space.
standard computer graphics usage.
[2]
space,
This
and that
is
15
2.1.1.2
To map a point from a window to a port, the
following
formulas
are used:
port x =
(window-x - window x_origin) *
porty =
(port_x_extent / window x extent)
(window_y - window y origin) *
(port_y_extent / window_y_extent)
2.1.2.3
Equations of the same general
form can be used for
the following mappings:
world window to screen port: answers the question
"where is
a point in the world located on the screen?"
tablet port to world window: answers the question
"where is the user pointing in the world when he locates
the puck at a point on the tablet?"
tablet port to screen port: answers the question
"where is the user pointing at on the screen when he
locates the puck at a point on the tablet?"
2.1.3
2.1.3.1
Zoom facility
The discussion
is
now expanded
to distinguish
between the screen, an grid of glowing phospher points,
the
frame buffer, an matrix of memory cells where
information is
stored.
There is not always
and
the image
a 1-1 mapping
16
from the buffer to the frame
screen array because some
buffers allow a subset of memory cells to be scanned and
displayed at a
I
larger size on the screen.
----------- >1
~
buffer
|
|
screen
(zoom example: 1/16 of the buffer is displayed on
the screen at 4 times normal
2.1.3.2
buffer,
size)
This feature is called zoom.
for
example, can display a
full image at full scale,
or zoom to 1/4 image at 2 times scale,
at 8.
The Grinnell GMR-270
1/16 at 4,
and 1/64
Other buffers allow zooming to all integral values
between 1 and 8,
and still others allow continuous zooming
from 1.0 to 8.
(and beyond).
closer
0
The zoom capacity allows
inspection of the image, and can also allow greater
precision in mapping tablet locations to the buffer
locations --
both desirable capabilities.
17
2.1.3.3
The Grinnell extracts a price
however.
for this facility,
The cursor is not stored in the frame buffer, but
is added to the rgb signal after scanning buffer memory.
The
cursor, therefore, does not alter any part of the
stored image, but is displayed via hardwired circuits that
do not adjust the position or size of the
for zoom.
The map package described in section 2.2
corrects the cursor position so
zoomed pixel it points
2.1.3.4
cursor to account
it is
in register with the
at.
Another consideration
is
that when zoom scale
greater than 1 some or even all of the port
world window and tablet port are mapped),
is
(into which the
may fall outside
of the displayed section of the buffer.
2.1.3.5
A
final consideration is
that it may be desirable
or convenient to have alternate ways
part of the buffer to zoom to.
to to specify which
Three different ways would
probably handle all needs:
1.
specify scale and point to be at origin of screen
when buffer
2.
is
displayed.
specify scale and point to be in center of screen
when buffer is displayed.
18
3.
specify scale and an invariant point, around which
all
scaling
occurs, and which would not change screen
position
before and after
scaling.
19
2.2
2.2.1
2.2.1.1
THE MAP PACKAGE: A
USER MANUAL
Introduction to map$ package
This
set of routines
facilitates the user's
control of three two-dimensional spaces:
the screen, the
tablet, and the world space of interest to the user.
The procedures of this package are bound together as a
single segment named
"map".
A
structure
parameters accessed by all procedures is
segment named
containing
in a separate
"map_param_01" which is managed
automatically by the package.
2.2.1.2
Use of space.
The user may have as many virtual
core memory spaces as he can think up four-letter names for.
Each space is 16 (addressed 'O'b4 to 'f'b4) 32K-byte
(addressed '0000'b4 to
'7fff'b4) segments. Each segment is
either object code or data. The
a
following schedule
shows
likely distribution of segments in a space when the map
package is used:
20
address
0
1
reference name
[unavailable to user]
[unavailable to user]
2
3
ioa, iocs, rl,
grin
4
5
6
math
use [the menu manager program]
map
scs, stty
7
io_util
8
9
a
b
c
d
e
f
com err
[user application procedure]
[user data segment]
mapparam_01
[menu tree data structure]
[unavailable to user]
linkage [and storage for based]
[storage for automatic variables]
Each map procedure refers to and stores data
in
map_param_01. The pointer to this segment is not passed as
a parameter, but is initialized automatically to the same
address
(b10000) at the
2.2.1.3
%include.
start of each procedure.
This file, when included in source code
of an application program, declares all map$ procedures.
2.2.2
The map$ procedures
2.2.2.1
map$setup.
This procedure is declared and used as
follows:
declare map$setup entry;
call map$setup;
21
The procedure must be called before any other map$procedure.
It calls map$loadparameters, which appends
the
"map_param_01"
(if necessary)
data segment in the current working
directory and initiates it at address
(see map$loadparameters).
'b'b4 in user space
It also sets default values for
each window:
coordinate space:
world window
screen/buffer port
tablet port
xorigin
0
0
76
y_origin
0
0
600
x extent
512
512
2048
yextent
512
512
1536
The world window is identified with the screen/buffer port.
Tablet port is based on four considerations:
resolution possible in each direction,
of puck on tablet,
pixels
(1) most
(2) comfortable fit
(4) ratio of tablet device units/
is an integral 3:1 for x, 4:1 for y,
screen
(4) more units
in direction of greater arm movement. The zoom scale is set
to 1, and cursor is turned on.
2.2.2.2
map$window.
This procedure and associated
variables are declared and used as follows:
declare
map$window
entry (float(23), float(23),
float(23), float(23)),
float(23),
float(23),
float(23),
float(23);
x origin
y_origin
x extent
y_extent
call map$window
(xorigin, yorigin, xextent, yextent);
22
The arguments are the origin and extent of the world window,
expressed in world units.
They define the range of values
to be returned by the map$int and map$fp routines.
parameters set by map$setup are
2.2.2.3
map$port.
Default
(0.0, 0.0, 511.0, 511.0);
This procedure and associated variables
are declared and used as follows:
declare
map$port
entry (fix(15),
fix(15)),
fix(15),
fix(15),
fix(15),
fix(15);
fix(15),
fix(15),
x origin
y-origin
x extent
y extent
call map$port
(xorigin, y_origin, xextent, y_extent);
The arguments are the origin and extent of the frame buffer
port. Values
for the origin may range from 0 to 511.
Origin + extent should not exceed 511 in either direction.
At zoom scale
1, the frame buffer and screen image are
identical. The arguments define the range of values to be
returned by the map$int and map$fp routines.
parameters set by map$setup are
(0, 0, 511,
Default
511).
23
2.2.2.4
map$tablet.
This procedure and associated
variables are declared and used as follows:
declare
map$tablet
entry (fix(15),
fix(15)),
fix(15),
fix(15),
fix(15),
fix(15);
fix(15), fix(15),
x origin
yorigin
x extent
yextent
call map$tablet
(x_origin, yorigin, xextent, y_extent);
The arguments are the origin and extent of the tablet port.
Values for the origin may range from 0 to 2200.
Origin +
extent should not exceed 2200 in either direction. Default
parameters set by map$setup are
2.2.2.5
map$xport.
This
(76,
600, 2000, 1500);
function and associated
arguments are declared and used as follows:
declare
map$xport
entry (float(23))
returns (fix(15)),
window x
float(23),
portx
fix(15);
port_x = map$xport (windowx);
This
function transforms points in world space to buffer
space.
It does not check, clamp, or clip.
So a point
which is not inside the window will transform into a point
which is not inside the port.
24
2.2.2.6
map$y_port.
This function and associated
arguments are declared and used as
follows:
declare
map$yport
entry (float(23))
returns
windowy
porty
port_y = map$yport
This
function transforms points
space.
It
(fix(15)),
float(23),
fix(15);
(window_y);
does not check,
in world space to buffer
clamp,
or clip.
So a point
which is not inside the window will transform into a point
which is
not inside the port.
2.2.2.7
map$fp.
This procedure and associated arguments
are declared as follows:
declare
map$fp
entry (fix(15), fix(15),
float(23), float(23), fix(15)),
port x
port_y
fpx
fpy
fix(15),
fix(15),
float(23),
float(23),
z
fix(15);
call map$fp (portx, port_y,
This procedure
fp_x, fp_y, z);
interrogates the tablet and maps the
resulting tablet coordinates into the
porty) and screen port
(fp_x, fp_y).
conditions, cursor number one
porty).
user window (port x,
Under default
is displayed at
(portx,
Cursor visibility and number (one through four)
25
can be controlled by calling map$cursor procedures.
z takes on the following values:
-l
0
1
2
4
8
3-15
2.2.2.8
puck is not on tablet
puck is on tablet, no buttons are pressed
puck is on tablet, z button is pressed (yellow)
puck is on tablet, button 1 is pressed (white)
puck is on tablet, button 2 is pressed (blue)
puck is on tablet, button 3 is pressed (green)
combination of buttons is being pressed
map$int.
are declared as
This procedure and associated arguments
follows:
declare
map$int
entry (fix(15),
fix(15)),
fix(15),
fix(15),
port x
port_y
int_x
int
y
call map$int
fix(15),
fix(15),
fix(15),
fix(15);
(portx, porty, int_x,
int_y);
This procedure works analogously to map$int.
int_y are derived by mapping the tablet
int
x and
location to the
window, and truncating the floating point values to
integers.
port x and porty (and consequently the cursor
position) are derived by mapping the integer window values
to the port.
This is
useful, among other things, for grid
gravity, or centering cursor on menu choices.
26
2.2.2.9
This procedure and associated
map$frameorg.
arguments are declared as
follows:
declare
frameorg
x origin
y origin
scale
call map$frame_org
entry (fix(15), fix(15), fix(15)),
fix(15),
fix(15),
fix(15);
(x_origin, yorigin, scale);
This procedure controls which part of the frame buffer is
displayed.
(x_origin yorigin) is the the pixel displayed
in the lower left corner of the
screen.
Scale works this
way for all of the map$frame procedures:
pixels displayed
512 x 512
256 x 256
128 x 128
64 x 64
scale
1
2
4
8
2.2.2.10
map$frame
ctr.
arguments
are declared as
This procedure
and associated
follows:
declare
entry (fix(15), fix(15), fix(15)),
framectr
x center
fix(15),
fix(15),
y~center
fix(15);
scale
call map$framectr (x_center, ycenter, scale);
This procedure controls which part of the frame buffer is
displayed.
(x
center y center)
the center of the screen.
is the pixel displayed in
Scale works as described
earlier.
27
This procedure and associated
map$frameloc.
2.2.2.11
arguments are declared as follows:
declare
entry (fix(15),
fix(15),
fix(15),
fix(15);
frame loc
x locus
y-locus
scale
call map$frameloc
fix(15),
fix(15)),
(x_locus, ylocus, scale);
This procedure controls which part of the frame buffer is
displayed.
does
(x locus ylocus) is an invariant pixel that
not change its displayed position as a result of
calling this procedure.
2.2.2.12
map$framereset.
called
follows:
as
This procedure is declared and
declare map$frame reset entry;
call
map$framereset;
This
is
equivalent
to calling
2.2.2.13
map$cursor.
called as
follows:
declare
map$cursor
number
screen x
screen y
call
map$cursor
map$frame
This procedure
org
(0,
0,
1);
is declared and
entry (fix(15),
fix(15),
fix(15),
fix(15),
fix(15);
(number, screen x,
screen-y);
fix(15)),
28
This
locates one of four cursors
(1, 2, 3, or 4)
at
(screenx, screen_y). Whether or not it is visible
controlled by map$cursor vis.
Scale
is
(specified in
map$frame calls) has no effect on cursor.
It always maps
to the screen as if scale were 1
2.2.2.14
map$cursor nbr.
called as
follows:
This procedure is declared and
declare
map$cursornbr entry (fix(15)),
number
fix(15);
call map$cursornbr (number);
This procedure controls which of four cursors
is
used when map$int or map$fp is
2.2.2.15
map$cursor vis.
(1, 2, 3, 4)
called.
This procedure is declared and
called as follows:
declare
map$cursorvis entry (fix(15)),
string4
bit(4);
call map$cursorvis (string);
The procedure controls which of the four cursors is
visible.
The cursors 1, 2,
positions 1, 2,
example
3, 4.
3, 4 correspond with string
'0'b is off,
'1'b is on.
'1010'b turns cursors 1 and 3 on.
For
29
2.2.2.16
map$loadparameters.
This procedure is declared
and called as follows:
declare map$loadparameters entry;
call map$loadparameters;
This procedure creates (if necessary) and loads the data
segment without initializing it.
It is safe to call this
procedure instead of map$setup only when the user is sure
that "map_param_01" has already been created and
initialized by a previous program.
30
2.3
2.3.1
FURTHER WORK
Device-independent graphics package
An obvious improvement in this package is making it a part
of a graphics package by adding lineto's, moveto's and
clipping.
A
further step is making it more machine
independent by changing the frame buffer space to
normalized origin of (0.0, 0.0) and extent of (1.0, 1.0).
It would then be adapted to each specific buffer by adding
one procedure which would transform normalized buffer
coordinates to actual device coordinates.
This would
achieve the usual tradeoff of greater generality for
somewhat slower execution time.
2.3.2
Record and playback
Another extension would be an ability to store input from
the tablet, and then at a later time read that data
memory as if it were coming from the tablet.
from
Input from
the keyboard could be stored and recalled in the same way.
31
This could be used for animations, and to record and replay
interactive sessions.
A simpler package to do this has
already been written by the author, and saves about 45
seconds worth of data from the tablet before memory is
filled.
2.3.3
System independence
These procedures communicate with each other by saving and
recalling data in a separate segment.
It is not clear that
this could be accomplished as easily in a system without
the explicit core memory management provided by the
MagicSix system.
32
3
MENUS
33
3.1
3.1.1
Requirements
3.1.1.1
An
THE IDEAS
for interactive graphics
interactive package which accomplishes a
task
such as page layout requires a complex set of procedures.
For the user
to move
from one procedure to the next in a
purposeful, efficient way, requires an interface with the
following
3.1.1.2
characteristics:
The
system must present options to the user and
respond to his choice
in a consistent manner.
Predictable
behavior makes it easier for the user to adjust to the
system. The
system should accommodate both new and
experienced users, especially with respect to prompts, so
that they are available to new users or can be ignored or
bypassed by experienced users.
The system should provide
feedback to reinforce choices,
and not allow unanticipated
choices to crash the process. Also, some accomodation has
to be made
for the
different ways.
fact that different
users use tools
in
34
3.1.1.3
All this places
special demands on the programmer
who, in turn, has needs of his own to be met with respect
to developing and coordinating
needs
large sets of programs. He
some way of organizing the procedures
the ones of immediate
select.
He needs
so that only
interest are presented to the user to
some way of managing
core memory
so that
procedures don't hang around when they are no longer needed
some operating
systems take care of this
for the programmer).
The changeability, modularity, and communication of values
between procedures.
3.1.2
Definition of a menu
3.1.2.1
The intuitive
answer seems to
of a menu, but this only seems
questions:
menus
3.1.2.2
what is a menu?
run programs,
I will
based on a
develop
call for some form
to presents further
Is it a procedure or data?
or do programs
to these questions
recursive definition of a menu:
of procedure-items and menu-items
a menu
is a list
such that if the user
selects a procedure-item a procedure is
user selects
Do
run menus?
some answers
(
run, and if the
a menu-item another menu is presented.
35
3.1.2.3
This is vague enough to postpone some
implementation considerations
for a while, but it still
permits some useful comparisons. The structure of a menu
like this can be repesented by a tree with programs at its
leaves, or terminal nodes, and menus as its root and
intermediate nodes. Another analog is an outline.
with items
Any item
indented beneath it represents a menu, and any
item without items indented beneath it represents a program.
The outline is a fortuitous analogy, as we shall see,
because it is a familiar form, it is easy to write and edit
and manipulate.
3.1.2.4
Both the tree and the outline can be modelled by
dynamic information structures known as hierarchical linked
lists. Since there are well-defined techniques
editing, and traversing linked lists [3],
for building,
it is now
possible to postulate a menu that is a data structure which
is created and managed by special programs.
36
3.1.3
Visual
3.1.3.1
format
So far
I have described the menu in a non-visual
way. The visual
form can be derived by describing general
its general properties.
displayed in a
any subarea
A menu is a list of items
screen port.
of the
Imenu
Iport
It should be able to occupy
screen.
I
I
screen
3.1.3.2
lists.
A menu port may contain vertical or horizontal
To this
end, the port may be divided into
equal-sized modules in which menu items
I item
I item
I--------|
| item
|
| item
|
i-------| item
I
I item
are displayed.
I item
I
37
3.1.3.3
Geometry suggests that a port may contain arrays
in addition to simple lists of these modules. This is,
fact,
useful for several purposes.
A
displayed more compactly as an array.
in
single list might be
Or this format might
display vertical lists of horizontal lists (and horizontal
lists of vertical lists) --
menu trees, such as I earlier
described.
item
I item
I item
--------------------------------------item
I item
I item
I item
I item
--------------------------------------item
I item
I item
I item
3.1.3.4
I
|
I
I
One of the advantages that accrues from dividing
the menu port into equal modules is that the position of
the puck on the tablet can be mapped easily and
unambiguously to the location of a menu item.
3.1.3.5
In addition to the item modules, a menu should
include prompts and feedback so that a mimimum
configuration might include a menu port, a title port, and
a prompt port all within a containing "ground port."
38
I
---------------------------------------
I
I title port
I
I-------------------------------------------I
I-------------------------------------------|
I
I prompt port
I
I
I
I
|
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
---------------------------------------
I-------------------------------------------I
I
I item
I
I
I
item
I item
I item
--------------------------------------I item
I
item
I
item
I item
I---------------------------------------I
|
item
I
item
I
item
menu port
I
ground port
(diagram of parts of a menu)
I
item
I
|
39
3.2
3.2.1
THE MENU PACKAGE:
The menu text
A USER MANUAL
file
3.2.1.1
This package of procedures bound together under
the name
"menu" turns a text file into a data structure --
a menu tree --
which is used for interactive
decision-making. A model menu is included in Appendix III.
The following paragraphs describe the four main sections
(and
functions)
3.2.1.2
editor.
The
of the text
file.
text file is created and edited in the TVmacs
The text file name should have the suffix
".
menu",
just as pll programs have the suffix ".pll".
3.2.1.3
The user may insert a comment on any line by
typing a vertical bar
(I).
All characters
from the
vertical bar to the end of the line will be ignored, and do
not become part of the menu data structure.
40
3.2.2
The menu outline
3.2.2.1
The programmer writes an outline that reflects the
pattern of choices he wants to make available on the screen.
The outline is made of menu-items and procedure-items.
Menu-items are
followed on the same line by prompts, which
give information about items
indented one further level
beneath them (if the user picks a menu item, another menu
appears
on the screen).
Procedure-items are followed on the
same line by a procedure which is run if that item is
chosen.
3.2.2.2
These are the rules
for making a menu outline. The
characters that flag the start of this section are
(no quotation marks) at the beginning of a
one
item per line.
name of the menu
There
line.
is only 1 first-level
"**MENU"
There is
item: the
(no indent, flush left) followed by the
first-level prompt.
To indent one from the preceeding item,
insert 1 extra tab, or 5 spaces, before the next label.
numbers or letters
indents.
(I.,
A.,
1.,
a.)
No
are necesary, use only
41
3.2.2.3
The syntax for a menu-item that results in another
menu is:
label
label
"prompt"
[match string]
If the prompt will fit on one line following the label,
single or double quotes may be used.
Otherwise, put a
match string in brackets after the label, and put the
same match string in brackets in the prompts section,
followed by the full text of the actual prompt.
3.2.2.4
The syntax for an item that calls a procedure is:
label: procedurename
For readability, extra carriage returns can be inserted
between lines.
Extra tabs and spaces can be included
between required elements.
only at
3.2.2.5
Tabs or spaces are significant
the beginning of the line.
Keep the labels short.
fit in the boxes
not displayed.
Any characters which don't
(see the ports section) are truncated, and
42
3.2.3
Prompts
3.2.3.1
Prompts give the user information on items at the
next sublevel.
Because the outline is restricted to one
line per item, the prompts section allows the programmer to
write as detailed a prompt as is needed, and to associate
it with a label by a match string in brackets.
3.2.3.2
are
The characters that flag the start of this section
"**PROMPTS"
prompt is as
(no quotation marks).
The syntax
for each
follows:
[match string]<cr>
This is whatever expanded prompt is wanted.
It may use as many lines as necessary.
The match string should be on a line by itself.
No quotation marks are necessary.
in the above example everything that follows the first
carriage return
the file is
3.2.3.3
in this
<cr>
is the full text of the prompt
flush left, not
(and in
indented).
Currently, you need to include
at least one prompt
section whether you really need it or not.
an inconvenience that will be
fixed.
This is
43
3.2.4
Ports
3.2.4.1
are
The
"**PORTS"
characters
(no
that
flag the
quotation marks)
at
start
of this
the beginning
section
of a
line.
3.2.4.2
The programmer
specifies the visual format
numerically by describing the dimensions of different parts
of the menu. Specification syntax is:
keyword followed by
10 parameters, separated by blanks or tabs,
line.
all
on a single
The parts of the menu, or ports, are as follows:
3.2.4.3
Keyword
"ground"
(this port contains the whole menu)
x origin
relative to screen origin
y_origin
relative to screen origin
width
in pixels
height
in pixels
x charpos
not relevant (put dummy parameter here)
y_charpos
not relevant (put dummy parameter here)
char width
not relevant (put dummy parameter here)
char-height
not relevant (put dummy parameter here)
outline width
width, in pixels, of the box outline
planes_8910
3-character string xxx where "x" is
0 if plane is not used, 1 if used
44
3.2.4.4
Keyword
"menu"
(this port contains all the menu item boxes)
relative to ground origin
x origin
relative to ground origin
y-origin
width
in pixels
height
x char pos
y char pos
char width
char-height
outline width
planes_8910
in pixels
not relevant (put
not relevant (put
not relevant (put
not relevant (put
width, in pixels,
3-character string
dummy parameter here)
dummy parameter here)
dummy parameter here)
dummy parameter here)
of the box outline
xxx where "x" is
0 if plane is not used, 1 if used
3.2.4.5
Keyword
"item"
(these ports contain the menu labels)
not relevant (put dummy parameter here)
x origin
not relevant (put dummy parameter here)
y origin
Ex origin and yorigin are taken to be (0, 0)]
in pixels
width
height
in pixels
x char pos
y char pos
char width
char height
outline width
planes_8910
3.2.4.6
Keyword
first char, relative to title origin
first char, relative to title origin
character spacing, in pixels
linespacing, in pixels
width, in pixels, of the box outline
xxx where "x" is
3-character string
0 if plane is not used, 1 if used
"title"
(this port contains the label of item which
is currently selected)
relative to ground origin
x origin
relative to ground origin
y-origin
in pixels
width
height
in pixels
x char pos
ychar-pos
char width
char-height
outline width
planes_8910
first char, relative to title origin
first char, relative to title origin
character spacing, in pixels
linespacing, in pixels
width, in pixels, of the box outline
xxx where "x" is
3-character string
0 if plane is not used, 1 if used
45
3.2.4.7
Keyword
(this
all
the prompts)
relative to ground origin
relative to ground origin
in pixels
height
x charpos
y_charpos
char width
char-height
outline width
planes_8910
in pixels
first char, relative to prompt origin
first char, relative to prompt origin
character spacing, in pixels
linespacing, in pixels
width, in pixels, of the box outline
3-character string xxx where "x" is
0 if plane is not used, 1 if used
Options
3.2.5.1
The characters that flag the start of this section
"**OPTIONS"
line.
contains
x origin
y_origin
width
3.2.5
are
port
"prompt"
(no
quotation marks).
The options are
specified as
3.2.5.2
Keyword
If "yes"
an asterisk is put before
at
the beginning
of a
follows:
"leafprefix" followed by "yes" or
labels
no
in procedure-item
boxes. Otherwise not.
3.2.5.3
Keyword
"blue", "green",
This
"plane_8"
"cyan",
followed by "black", "red",
"magenta",
"yellow",
option colorizes overlay plane 8.
or "white".
46
Keyword "plane_9" followed by same possible
3.2.5.4
arguments
3.2.5.5
as plane_8, with corresponding effect.
Keyword "plane 10" followed by same possible
arguments as plane_9, with corresponding effect.
3.2.5.6
Keyword
"continuous".
all
the time.
In
"mode"
followed by "popup" or
continuous mode,
In popup mode,
the menu is
displayed
it goes away after user has
chosen a procedure and reappears after the procedure has
finished executing.
3.2.6
Making the menu
After the text file has been completed, it is
turned into a
menu-tree data file by running the menu program with the
text
file name
(with or without the ".menu")
as an argument:
menu textfile
or
menu textfile.menu
It is analagous
to compiling a pll program.
The menu
program does not print error messages, but does print out
47
the current
line(s) in the text file that
it is working on.
If the menu program finds some syntax error it can't handle,
the user then should then inspect that
line of the textfile.
After the menu-tree file is made, it can be used by the
"use" program.
48
3.3
3.3.1
THE USE PACKAGE:
A USER MANUAL
Using the menu data segment
The menu program processes a text file called
"something.menu" into a data file which it calls
"something".
simply
Using the menu requires the user to type "use
something" at command level.
If he types
simply "use",
the
use program will prompt for the menu name.
3.3.2
Use of
space
As noted in the map section, the user may have as many virtual
core memory spaces as he can think up four-letter names
Each space is
(addressed
16
(addressed '0'b4 to
'0000'b4 to
following schedule shows
a likely distribution of segments
is used
'f'b4) 32K-byte
'7fff'b4) segments. Each segment is
either object code or data. The
package
for.
in a space when the
(note that "use" calls
"map"):
use
49
address
0
1
2
reference name
[unavailable to user]
[unavailable to user]
ioa, iocs, rl, scs, stty
3
grin
4
5
6
7
8
9
a
b
c
d
e
f
math
use [the menu manager program]
map
io util
com err
[user application procedure]
[user data segment]
map_param_01
[menu tree data structure]
[unavailable to user]
linkage [and storage for based]
[storage for automatic variables]
The use package terminates each procedure on the menu tree
after that particular program has returned. However, it is
the user's responsibility to terminate procedures that are
called by procedures on the menu-tree.
3.3.3
Communication between programs
It is very common that programs will need to share data, or
need a global variable.
The menu tree works against this
to some extent because it calls separate programs without
passing arguments.
manner:
However, data can be
shared in this
place all data in a based pll structure;
initiate
50
this segment whose base address is the pointer that
addresses the structure.
The MagicSix/pll operating
environment has a procedure designed expressly for this
purpose.
It is hcs$initiatewith_options, and allows a
segment to be explicity assigned to any one of the core
addresses in the above schedule.
51
3.4
3.4.1
FURTHER WORK
Improved error-handling
The menu program would be a far more useful
flagged syntax errors rather than
encountered them.
tool if it
just blew up when it
Perhaps a separate program that
previewed the text file for proper
form before
it was
handed to the menu program would be the best way to
accomplish thsi at this point.
syntax is
At any rate, the menu
simple enough at this rate so that finding
mistakes has been a simple matter.
3.4.2
In this
More general menu formats
first version, menus build up from the lower left
hand corner of the screen.
It would be interesting to see
if menus would work better if they built from top to bottom
as well as bottom to top, and from right to
left to to right.
left as well
Perhaps ultimately, menus could be
from being straight lists and arrays:
they might
as
freed
simply be
linked lists of arbitrarily-placed boxes on the screen.
52
3.4.3
Dynamic menus
This area still has a lot of interesting work yet to be
done.
The menu-tree would be
far more useful
if it were a
dynamic structure, which changed as the user used it.
It
would permit changing the visual format of the menu while
it was being used, menus that called other menus, display
and generation of data as well as the pre-programmed
calling of programs.
53
4
TYPE DIGITIZATION
54
4.1
4.1.1
THE IDEAS
Type digitization techniques
4.1.1.1
Turning a visual
letterform into numbers can be
done in a number of different ways.
Bit maps record the
light/dark values at a two-dimensional array of locations
in a rectangle which encloses a type form.
The light/dark
values may be single (0 or 1) or multiple bit (0 to 8, or 0
to 255,
for
example).
Bit maps are efficient at
sizes, but quickly grow to unwieldly sizes.
small
Run codes
slice through letterforms and record the number of same
light/dark values
in a sequence.
This method produces a
more compact code than bit maps, but takes
a slightly more
complex algorithm to reconstruct the letterform.
4.1.1.2
The most efficient codes in terms of storage are
edge-codes, which themselves only with the contour of the
letterform.
Spline edge codes store the edge as a series
of control points.
The shape is reconstructed by fitting
55
the control points into equations which describe the lines
that make contour.
Somewhat simpler are chain codes,
record unit x and y increments as the shape of the edge is
traced.
This chain code technique is the method used and
explained here.
4.1.2
An edge-detecting routine
4.1.2.1
The edge of the contour is found by starting
outside the contour
(at A,
for example, in the following
diagram) and reading the color along a row of pixels. The
first pixel lighter than middle grey is the origin of the
contour
(at B).
(Other threshold values might be used,
depending on the nature of the image).
<-|
I in
|
B
|
in
inside
direction of search
A
||
I out | out | out I out I
I outside
56
4.1.2.2
Next, the direction of the search is rotated 90
degrees clockwise, with this result:
the pixel to the
right of the origin is known to be outside the origin
because its value was tested as a part of the procedure.
new direction of search
I
- -^
I
I in
4.1.2.3
I
- -
I out
I
I
<--
initial direction of search
|
The process is now to advance along the contour,
always moving into a new cell whose right-hand neighbor is
outside the contour. This is a necessary and sufficient
condition to ensure that a complete bounded area will be
recorded.(It is analogous walking through a maze with one
hand always on the wall to ensure that you trace the whole
maze and exit where you entered.)
As each move is made, a
record is kept of x- and y-increments, known as a chain
code.
57
4.1.2.4
The following diagram shows the questions to be
is the pixel
answered at each step along the edge:
directly forward in our out?
the left
in or out?
I
I
I ?
I
I
I ?
I
I
I
I in
I out
I
4.2.1.5
is the pixel forward and to
These are the three possible ways these questions
might be answered:
I
I
I
I
I
I
I out I out I
I-----I-----I
I
I in
1 I
I
I out I
(1)
I
I
I in
I
I
I
I
I
I
I
I in
I out I
I out I
I in
----- I----I in
I
out
(2)
I in
(3)
I
I
58
4.1.2.6
In case
(1) we have reached an outside corner.
It
is necessary to rotate our direction of search 90 degrees
counterclockwise.
In case (2) the edge is
advance straight ahead. In case
corner.
straight, and we
(3) we are on an inside
We must advance one unit ahead, one unit to the
right, and then turn 90 degrees clockwise.
These tests and
moves are repeatedly applied until we arrive back at the
pixel we started at.
4.2.1.7
The actual code which does the checking described
above has the name
be written
in
"check-ahead" and an algorithm which may
english as follows:
If the pixel directly ahead is out then change
direction of search 90 counterclockwise, (no need to
add a link to the chain code) and start test over
again.
Otherwise pixel directly ahead is in (but we don't yet
know whether it's on the edge or in the interior).
Therefore, make the following test:
If the pixel located forward and to the right is
out, then advance forward, add a link to the
chain code, and start test over again.
Otherwise the pixel located forward and to the
right is in.
Advance forward and to right, add a
link to the chain code, change direction of
search 90 clockwise, and start the test over
again.
Do this until the origin is reached again.
59
4.1.3
Chain coding
4.1.3.1
The links added to the chain code will be of this
nature:
Whenever you add a link to the chain code, it will
be a four-bit string,
two bits to record the x-increments
and two bits to record the y-increments, the two-bit codes
being:
'Ol'b
+1 unit
'00'b
'll'b
0 units
-l unit
4.1.3.2
means
Two additional codes complete the set:
end of a contour
(no more x and y
'1010'b means end of a set of contours,
'0000'b
increments),
should the
character require more than one contour.
4.1.4
4.1.4.1
Alternate chain coding routine
An even more efficient code consists of three bits
per link, and requires that the number of links in a
contour be stored separately rather than being flagged in
one of the links
as in
the
first
example.
60
I
I
I
6 15
I 110 I 101
I
4
I 100
I
I
I
I
I
I
*
171
I 111 I
I-----I----------I
I
I
I 000 I 00i1
4.1.4.2
131
1 I
I
l
01
eI
In this method, the current point is assumed to be
in the center
(*)
of a 9-unit matrix.
The next point on
the contour can be in any one of 8 positions, which can be
recorded by the specific 3-bit code shown.
61
4.2
4.2.1
THE CONTOUR PACKAGE: A USER MANUAL
Description
4.2.1.1
The
structural
the font gun
font gun has four elements.
element is a polaroid copy stand oriented
horizontally (the post
vertical).
The main
is horizontal, the copy board
A vidicon digitizing camera is attached to a
mount on the post so that its distance from the copy board
may be adjusted.
A platform is attached to the copy board
with two adjustable screws so that its vertical position
may be precisely adjusted.
copy board
||
|
|
I
I
|
I
typositor film
held vertically
in track
||
on platform
||
|
||
|
I
II
--------------->[ VIDICON CAMERA ]
I
adjustable
|
platform
I I
on copy board
I
adjustable
mount
| on post
(polaroid copy board and post in horizontal position)
62
4.2.1.2
The
final element is a Visual Graphics Corporation
Typositor type font, a filmstrip about 2 inches wide and 10
feet in length, which carries negative images of a whole
font of characters with very precisely aligned baselines.
The quality of the film negative font images
fonts on the
Visual Graphics Typositor is such that a single
character
can fill the screen with no appreciable loss of quality.
4.2.1.3
The film is held at right angles to the camera
lens in a track on the platform, so there is no keystoning,
and the two screw adjustments at either end of the platform
make it possible to align horizontal letterstrokes with
raster
lines of the camera. A white
behind the film, illuminated with a
field, about two inches
15-watt bulb, provides
sufficiently even back-lighting.
4.2.2
Setup to digitize a font
4.2.2.1
Thread the typositor
film through the plastic
tracks on the platform. Turn on the vidicon camera with AGC
(automatic gain control) off.
backlight
the typositor strip.
Turn on the 15-watt bulb to
63
4.2.2.2
At the computer terminal type:
tmrq * <cr>
cwd >u>type <cr>
contour <cr>
4.2.2.3
(clear core memory)
(get in the right directory)
(run the capture program)
The program will ask for:
name of font file
source of font (VGC typositor font code number)
today's date
4.2.2.4
Type in a character string for each answer.
use spaces;
use underbars
string with double quotes,
(_).
Don't
Alternatively, surround the
and then you can use spaces. The
VGC typositor font code number is found at the beginning
and end of each film strip.
This information
is
helpful if
we ever need to go back to a recapture chararcters
from a
font.
4.2.2.5
Next the program will list options:
v
c
x
vidicon input
set cap height via tablet
set x height via tablet
b
set baseline via tablet
n
d
set cap-x-baselines numerically via keyboard
display cap-x-baseline values at terminal
q
quit
64
4.2.2.6
This is the setup loop.
continuous vidicon digitizing.
on the monitor.
First press "v" to start
The type image will appear
Do these things now:
Adjust size,
focus,
and pull enough of the font past the lens to see that the
lowest descenders and the highest ascenders fit on the
screen.
Press <spacebar> to stop digitizing.
4.2.2.7
The program will again list the above options, and
this time, press
"b",
"Ic
x- height or cap-height.
z button
button 1
button 3
button 2
4.2.2.8
press
(yellow)
(white)
(green)
(blue)
,
or
"x",
to mark the baseline,
Using the puck, press:
to
to
to
to
set the line at cursor position
bump line down one pixel
bump line up one pixel
accept line position.
Once the baseline, x-height, or capline is
"v" to
set,
start vidicon again, and pull some more
characters across the screen to check the alignment.
Use
the screws on each end of the platform if adjustment is
needed.
When alignment is finished, press
the values of cap-x-baselines
of them --
"d" to display
at the terminal.
these numbers will be needed later.
Make a note
65
4.2.2.9
An alternative to setting cap-x-baselines
tablet is to press
"n"
via
and enter the values numerically at
the keyboard. This allows exact correspondence of values
between two
judgements
4.2.2.10
files rather than having to make visual
at the beginning of each file.
At the conclusion of this setup activity, press
"q"
to quit setup, and progress to the actual capture of
the
font.
4.2.3
Capturing the characters
4.2.3.1
The capture loop will
continuous
automatically start out in a
digitizing mode to allow a single character to
be positioned in the center of the screen.
been done, press
button 1
contours.
< spacebar>
When this has
to stop digitizing and press
(white) on the puck to begin acumulating character
For each contour, position the cursor to the
left of an edge and press the z button
monitor which displays overlay plane
be displayed.
(yellow).
10,
On the
the contour will
66
4.2.3.2
To complete the capture of a character, press
button 4
(green) to indicate that all contours which define
a
letter have been accumulated.
some statistics on the letter
amount of storage, etc.)
name to be
The program will print out
(maximum width and height,
and will prompt for the character
associated with the letter.
4.2.3.3
To indicate that you are done with a file, press
button 2
(blue), and the program will redraw all the
outlines it has accumulated.
67
4.3
4.3.1
FURTHER WORK
Processing the raw captured fonts
Using the methods and programs described in the previous
sections, it has been possible to capture about 16 fonts
a time of 2-3 hours per font.
This of course is the
capture of raw font information.
The work that remains is
to process this data so characters can be called back to
the screen in reduced, multiple-bit form to simulate
headline and text at any required size and orientation.
4.3.2
Design and editing of new fonts
Once basic typeforms have been captured, the actual shape
of the edge
can be changed, smoothed, and recoded, using
more compact and refined spline techniques.
This methods
is general enough so that it can apply to to visual forms
beyond familiar typeforms:
at
foreign character sets,
ideograms, high contrast images,
and logotype forms.
68
5
CONCLUSION
69
5.1
5.1.1
THE NATURE OF THESE TOOLS
Objects versus pixels
The software tools described here make it possible for the
designer to work with objects rather than with pixels.
distinction is
important, because it
tyranny of the device.
The
frees him from the
No longer is he restricted to
directly addressing pixels on the screen.
point at and refer to objects
The designer can
(or models of objects)
in the
real world, with collections of attributes far richer than
just color or grey level.
This makes the designer no less
of a picture-maker, but a worker with an expanded
set of
opportunities to plan, assemble, control, and refine, and
edit.
5.1.2
Linked lists
Central to all of this increased capacity is the use of
dynamic data structures and linked lists.
The software
70
tool builder should acquaint himself with these techniques.
[3,4]
The basic editing routines of inserting, deleting,
copying, sorting, and searching seem to apply to all kinds
of work dealing with lists of any type of objects.
5.1.3
Tools to build tools
Building a tool means looking at a problem in a general
enough way to expose the process required to solve
it.
Using a tool, once built, makes future work more productive.
This effort has proved the value of modular programming,
using software tools already built to help build new ones.
This is the
spirit of Gerstner's
"programmes for solutions."
71
REFERENCES
72
REFERENCES
[1]
Karl Gerstner, Designing Programmes, trans D. Q.
Stephenson, (Teufen, Switzerland: Arthur Niggli
Ltd., 1968), p.9.
[2]
Newman, William M., Principles of Interactive Computer
Graphics, (New York: McGraw-Hill, 1979), p. 8 3 .
[3]
Wirth, Nicklaus, Algorithms + Data Structures =
Programs, (Englewood Cliffs, N.J.: Prentice Hall,
1976).
[4]
Knuth, Donald E, The Art of Computer Programming,
Second Edition, (Reading Massachusetts:
Addison-Wesly, 1973).
Volume 1: Fundamental Algorithms
Volume 3: Searching and Sorting
73
ACKNOWLEDGMENTS
74
ACKNOWLEDGEMENTS
I want to thank these people:
My family, Marion, Tom, Jay, Zan, and Lee, whose love and
support made these two years at M.I.T. possible.
Muriel Cooper, Ron MacNeil at the Visible Language Workshop,
and Ken Sloan, Patrick Purcell at the Architecture Machine
Group for guidance, help, and occasional impossible demands
that spurred progress.
Lorna Shanks at Xerox, Mike Parker at Bitstream, Ed
Schwalenberg at Camex, who added a real-world perspective
to this effort.
Anne Russell, Rob Haimes, Lee Silverman, good people whose
help and counsel has made this work go smoother.
Fellow graduate students, both here and departed.
Sandy, Debbie, Pam, and Bobby Loring, my family away from
home, for encouragement and support.
Richard Durling-Shyderoff for innumerable contributions
in the realm of philosophy.
75
APPENDIX I
Source code for map package
76
1
>u>nardy>map>map.bind, 02:49:10 Thursday April 28,
map
loadparameters
setup
cursor
cursor vis
cursor nbr
frameorg
frame ctr
frameloc
framereset
recalc
window
port
tablet
x_port
y_port
int
fp
raw xyz
io util
1983
77
1
>u>nardy>map>mapdcl.incl.pll, 02:57:21 Thursday April 28,
1983
declare
map$loadparmeters
mapssetup
mapScursor
inap$cursor vis
rnap$cursornbr
map$frameorg
map~frame ctr
map$frame loc
map$frame reset
mapStablet
map$window
map$port
map$xport
map~y_port
mapsint
map$fp
entry,
entry,
entry (fix(15),
fix(15), fix(15)),
entry (bit(4) ),
entry (fix(15)),
entry (fix(15),
fix(15), fix(15)),
entry (fix(15),
fix (15), fix(15)),
entry (fix(15),
fix(15), fix(15)),
entry,
entry (fix(15), fix(15), fix(15), fix(15)),
entry (float(23), float(23), float(23), float(23)),
entry (fix(15), fix(15), fix(15), fix(15)),
entry (float(23)) returns (fix(15)),
entry (float(23)) returns (fix(15)),
entry (fix(15), fix(15), fix(15), fix(15), fix(15)),
entry (fix(15), fix(15), float, float, fix(15));
78
1
>u>nardy>map>p dcl.incl.pll, 02:58:13 Thursday April 28,
1983
declare
pointer,
based (p),
p
l q
2 Uwin,
3 xorg
3 yorg
3 xext
3 yext
2 Uprt
2 Utab
2 win
2 tab
2 prt
2 buf
2 cur
2 scr
2 xoffset
2 yoffset
2 scale
2 cur nbr
2 cur vis
/* user window, world coord's *7
float(23),
float(23),
float(23),
float(23),
like Uwin,
like Uwin,
like Uwin,
like Uwin,
like Uwin,
like Uwin,
like Uwin,
like Uwin,
float(23),
float(23),
float(23),
fix(15),
bit (16);
/ * user screen port, scrn c's *
/* user tablet port, tab c's
/* scaled part of user window *
/* scaled part of user tablet *
/* scaled part of user port
*
/* scaled part of frame buffer*/
/* cursor port
*
7* cursor space 0-->511
*
/*
/*
1, 2, 3, 4
'000x'b4 where x =
'4321'
*7
*7
79
1
>u>nardy>map>loadparameters.pll,
02:50:29
Thursday April 2E, 1983
load parameters: procedure;.
declare
scs~get_wdir
entry (char(168)vary),
hcs~append_seg entry (char(168)vary, char(32)vary, fix(31)),
hcs$initiate_w_options entry (char(168)vary, char(32)vary,
char(32)vary, bit(l), pointer, fix(31)),
dirname
char(168)vary,
param_ptr
pointer,
syscode
fix(31),
oops
condition;
syscode manager: procedure (string);
declare
com_error entry options (variable),
string
char(64)vary;
call com error (syscode, "loadparameters", string);
signal oops;
end;
on oops begin;
goto exit;
end;
unspec (param ptr) = '000b0000'b4;
call scs~get_ wdir (dir name);
call hcs~append seg (dir name, "mapparam_01",
if syscode
~=
syscode);
-14 then do;
if syscode < 0 then call syscodemanager ("making 'map_param_O'l'");
end;
call hcs~initiate_w_options
(dir name, "map_param_01", "mapparam_01", 'l'b, paramptr, syscode);
if syscode < 0 then call syscode_manager ("initiating 'map_param_01'");
exit:;
end;
80
I
>u>nardy>map>setup.pll, 02:51:30 Thursday April
28, 1983
setup: procedure;
%include p dcl;
declare
$loadparameters
$frameorg
entry,
entry (fix(15),
fix(15),
/*********************************************
stuff: procedure
fix(15));
*
(xorigin, yorigin, x extent, yextent, aptr);
declare
x-origin
y_origin
x extent
y_extent
a_ptr
1a
2 xorg
2 yorg
2 xext
2 yext
a_ptr->a.xoro
a_ptr->a.yorg
a ptr->a.xext
a_ptr->a.yext
float (23),
float (23),
float(23),
float (23),
pointer,
based (a ptr),
float(23T,
float(23),
float(23),
float(23);
= x origin;
= yorigin;
= x extent;
= y extent;
endc;
/*********************************
******************************
call $loadparameters;
unspec (p) = '000b0000'b4;
call
call
call
call
call
stuff
stuff
stuff
stuff
stuff
( 0.0,
0.0,
(77.0, 601.0,
( 0.0,
0.0,
( 0.0,
0.0,
( 0.0,
0.0,
p->q.scale
p->q.cur nbr
p->q.curvis
512.0,
2048.0,
512.0,
512.0,
512.0,
= 1.0;
= 1;
= '0001'b4;
call $frameorg (0, 0, 1);
end;
512.0,
1536.0,
512.0,
512.0,
512.0,
addr
addr
addr
addr
addr
(p->q.Uwin));
(p->q.Utab));
(p->q.Uprt));
(p->q.scr));
(p->q.buf));
81
1
>u>nardy>map>cursor.pll, 02:55:26 Thursday April 28, 1983
cursor:
procedure
(nbr, x, y);
%include pdcl;
declare
(x, y, nbr)
grin$vis
grin pos
fix(15),
entry (bit(16)),
entry (fix(15), fix(15),
fix(15));
call grin~vis (p->q.cur vis);
call grinpos (p->q.cur nbr,
((x - p->q.buf.xorg) * p->q.scale) + p->q.xoffset,
((y - p->q.buf.yorg) * p->q.scale) + p->q.yoffset);
end;
82
1
>u>nardy>map>cursor vis.pll,
cursorvis:
02:55:45 Thursday April 28,
procedure (string4);
%include pdcl;
declare
grin$vis
stringl6
string4
entry (bit(16)),
bit(16),
bit(4);
stringl6 = '000'b4;
substr (stringl6, 13, 4) = substr (string4, 1, 4);
call grin~vis (stringl6);
p->q.curvis = stringl6;
end;
1983
83
1
>u>nardy>map>cursor nbr.pll, 02:56:13 Thursday April 28,
cursornbr: procedure (number);
%include p_dcl;
declare number fix(15);
p->q.cur nbr = number;
end;
1983
84
1
>u>nardy>map>frame org.pll, 02:59:27 Thursday April 28,
frameorg: procedure
1983
(x origin, yorigin, scale);
%include pdcl;
declare
(xorigin, yorigin, scale)
(x center, y center)
(xgrin, ygrin, zoom_nbr)
declare
grin$zoom entry (fix(15),
Srecalc
entry;
fix (15),
fix (15),
fix (15);
fix(15),
fix(15)),
/***********************************************************
unspec(p) =
'000b0000'b4;
p->q.buf.xorg = xorigin;
p->q.buf.yorg = y origin;
p->q.buf.xext = 512 / scale;
p->q.buf.yext = p->q.buf.xext;
p->q.scale = scale;
x center = p->q.buf.xorg + (p->q.buf.xext
y_center = p->q.buf.yorg + (p->q.buf.yext
xgrin = x center - 1;
ygrin = y center - 1 if
scale = 1 then
else if scale = 2 then
else if scale = 4 then
else if scale = 8 then
call grin$zoom (xgrin,
call Srecalc;
(32 / scale);
zoomnbr = 0;
zoom nbr = 1;
zoom nbr = 2;
zoom nbr = 3;
ygrin, zoomnbr);
/
/
2.0);
2.0);
85
1
>u>nardy>map>framectr.pll, 03:00:45 Thursday April 28,
frame ctr: procedure
(xcenter, ycenter, scale);
%include pdcl;
declare
(xcenter, ycenter, scale)
(xgrin, ygrin, zoom_nbr)
declare
grin~zoom entry (fix(15),
Srecalc
entry;
/**
*****
**
*********
unspec(p) =
**
***
**********
fix(15),
fix(15);
fix(15),
fix(15)),
**********
'000b0000'b4;
p->q.buf.xext = 512 / scale;
p->q.buf.yext = p->q.buf.yext;
p->q.buf.xorg = x center - (p->q.buf.xext
p->q.buf.yorg = ycenter - (p->q.buf.yext
p->q.scale = scale;
xgrin = x center - 1;
ygrin = y center - 1 if
scale = 1 then
else if scale = 2 then
else if scale = 4 then
else if scale = 8 then
call grin$zoom (xgrin,
call Srecalc;
end;
***********
(32 / scale);
zoom nbr = 0;
zoomnbr = 1;
zoom nbr = 2;
zoom nbr = 3;
ygrin, zoom nbr);
/
/
2);
2);
**********
1983
86
>u>nardy>map>frame_ loc.pll, 03:0l:46 Thursday April 28,
1
frame loc:
procedure
1983
(xlocus, ylocus, scale);
%include p_dcl;
declare
(xlocus, ylocus, scale)
(xcenter, ycenter)
(xgrin, ygrin, zoom_nbr)
declare
grin$zoom entry (fix(15),
$recalc
entry;
declare
systemao
ioa
/
fix(15),
fix(15),
fix(15);
fix(15),
fix(15)),
condition,
entry options (variable);
*************************************/
on Eystemao begin;
end;
unspec(p) =
'000b0000'b4;
p->q.buf.xext = 512 / scale;
p->q.buf.yext = p->q.buf.xext;
p->q.buf.xorg = x locus - (((x locus - p->q.buf.xorg) * p->q.scale) /
p->q.buf.yorg = y_locus - (((y_locus - p->q.buf.yorg) * p->q.scale) /
p->q.scale = scale;
x center = p->q.buf.xorg + (p->q.buf.xext / 2.0);
y_center = p->q.buf.yorg + (p->q.buf.yext / 2.0);
xgrin = x center -
1;
ygrin = ycenter - 1 if
scale = 1 then
else if scale = 2 then
else if scale = 4 then
else if scale = 8 then
call grin~zoom (xgrin,
(32 / scale);
zoomnbr = 0;
zoom nbr = 1;
zoom nbr = 2;
zoomnbr = 3;
ygrin, zoom_nbr);
call ioa ("
buf.xorg = ^f, buf.yorg = ^f, buf.yext = ^f, buf.yorg =f",
p->q.buf.xorg, p->q.buf.yorg, p->q.buf.xext, p->q.buf.yorg);
call ioa ("x center = ^4i, y center = ^4i", x center, y-center);
("
~ xgrin =
call
ioa
call
Grecalc;
end;
^4i,
ygrin =
^4i",
xgrin, ygrin);
scale);
scale);
87
1
>u>nardy>map>recalc.pll, 03:15:50 Thursday April 28, 1983
recalc: procedure;
%include pdcl;
declare
(buflox, buf_loy, buf hix,
bufhiy)
(Uprtlox, Uprt_loy, Uprt hix, Uprt hiy)
(prtlox, prt loy, prt hix,
prt hiy)
prtext
integerpart
declare
ioa
systemao
entry options
condition;
float(23),
float(23),
float(23),
float(23),
fix(15);
(variable),
*****************************************************************
/
on systemao begin;
end;
unspec
(p) =
'000b0000'b4;
if p->q.buf.xorg > 0 then do;
integerpart = p->q.buf.xorg;
p->q.xoffset = (p->q.buf.xorg - integerpart) * p->q.scale;
end;
else do;
integerpart = p->q.buf.xorg;
p->q.xoffset = (1.0 - (integerpart - p->q.buf.xorg)) * p->q.scale;
end;
if p->q.buf.yorg > 0 then do;
integer part = p->q.buf.yorg;
p->q.yoffset = (p->q.buf.yorg - integerpart) * p->q.scale;
end;
else do;
integerpart = p->q.buf.yorg;
p->q.yoffset = (1.0 - (integerpart - p->q.buf.yorg)) * p->q.scale;
end;
/*
/*
/*
/*
clamp new prt edges to buf edges, if necessary */
first convert org-ext to lo-hi */
buf (part displayed) may go outside of physical fb limits
*/
Uprt never goes outside fb limits, however, so clamping works ok
if
p->q.buf.xext > 0 then do;
buf lox = p->q.buf.xorg;
buf hix = p->q.buf.xorg + p->q.buf.xext end;
1.0;
*/
88
2
>u>nardy>map>recalc.pll
else do;
buf hix = p->q.buf.xorg;
buflox = p->q.buf.xorg + p->q.buf.xext + 1.0;
end;
if
p->q.buf.yext > 0 then do;
buf loy = p->q.buf.yorg;
buf-hiy = p->q.buf.yorg + p->q.buf.yext - 1.0;
end;
else do;
buf hiy = p->q.buf.yorg;
buf_loy = p->q.buf.yorg + p->q.buf.yext + 1.0;
end;
if
p->q.Uprt.xext = 0 then do;
end;
else if p->q.Uprt.xext > 0 then do;
Uprt_lox = p->q.Uprt.xorg;
Uprthix = p->q.Uprt.xorg + p->q.Uprt.xext - 1.0;
end;
else do;
Uprthix = p->q.Uprt.xorg;
Uprt_lox = p->q.Uprt.xorg + p->q.Uprt.xext + 1.0;
end;
if
p->q.Uprt.yext = 0 then do;
end;
else if p->q.Uprt.yext > 0 then do;
Uprt_loy = p->q.Uprt.yorg;
Uprthiy = p->q.Uprt.yorg + p->q.Uprt-yext - 1.0;
end;
else do;
Uprt_hiy = p->q.Uprt.yorg;
Uprt_loy = p->q.Uprt.yorg + p->q.Uprt.yext + 1.0;
end;
prt-ext = 1.0; /* just some value that is not 0.0
if
buf hix > Uprt hix then do;
iT bufTlox > Uprt hix then prtext = 0.0;
else prthix = Uprthix;
end;
else prthix = bufthix;
if
buf hiy > Uprt hiy then do;
if bufT_loy > Uprt hiy then prtext = 0.0;
else prt hiy = Uprt hiy;
end;
else prt hiy = buf hiy;
*/
89
3
>u>nardy>map>recalc.pll
if buflox < Uprtlox then do;
if buf hix < Uprtlox then prtext = 0.0;
else prtlox = Uprtlox;
end;
else prt lox = buf lox;
if bufloy < Uprtloy then do;
if buf hiy < Uprtloy then prtext
else prt_loy = Uprtloy;
end;
else prt loy = buf loy;
0.0;
/* convert lo-hi to org-ext and assign new values to structure */
if prtext = 0.0 then do;
p->q.prt.xext = 0.0;
p->q.prt.yext = 0.0;
end;
else do;
if p->q.Uprt.xext < 0 then do;
p->q.prt.xorg = prt hix;
p->q.prt.xext = prt lox - prt hix
end;
else do;
p->q.prt.xorg = prtlox;
p->q.prt.xext = prt-hix - prtlox
end;
if p->q.Uprt.yext < 0 then do;
p->q.prt.yorg = prt hiy;
p->q.prt.yext = prtloy - prt hiy
end;
else do;
p->q.prt.yorg = prtloy;
p->q.prt.yext = prt hiy - prtloy
end;
end;
-
1.0;
+ 1.0;
-
1.0;
+ 1.0;
now figure the origins and extents */
prt/buf = tab/Utab = cur/scr; prt/Uprt = win/Uwin * /
solve for c = (a/b)*d */
the equation is a/b = c/d.
p->q.tab.xorg = p->q.Utab.xorg +
(((p->q.prt.xorg - p->q.buf.xorg) / p->q.buf.xext) * p->q.Utab.xext);
p->q.tab.yorg = p->q.Utab.yorg +
(((p->q.prt.yorg - p->q.buf.yorg) / p->q.buf.yext) * p->q.Utab.yext);
p->q.tab.xext = (p->q.prt.xext / p->q.buf.xext) * p->q.Utab.xext;
p->q.tab.yext = (p->q.prt.yext / p->q.buf.yext) * p->q.Utab.yext;
p->q.cur.xorg = p->q.scr.xorg +
90
4
>u>nardy>map>recalc.pll
(((p->q.prt.xorg - p->q.buf.xorg) / p->q.buf.xext) * p->q.scr.xext);
p->q.cur.yorg = p->q.scr.yorg +
(((p->q.prt.yorg - p->q.buf.yorg) / p->q.buf.yext) * p->q.scr.yext);
p->q.cur.xext = (p->q.prt.xext / p->q.buf.xext) * p->q.scr.xext;
p->q.cur.yext = (p->q.prt.yext / p->q.buf.yext) * p->q.scr.yext;
p->q.win.xorg = p->q.Uwin.xorg +
(((p->q.prt.xorg - p->q.Uprt.xorg) / p->q.Uprt.xext) * p->q.Uwin.xext);
p->q.win.yorg = p->q.Uwin.yorg +
(((p->q.prt.yorg - p->q.Uprt.yorg) / p->q.Uprt.yext) * p->q.Uwin.yext);
p->q.win.xext = (p->q.prt.xext / p->q.Uprt.xext) * p->q.Uwin.xext;
p->q.win.yext = (p->q.prt.yext / p->q.Uprt.yext) * p->q.Uwin.yext;
end;
proportions for equations:
(buf' - bufxora') / bufxext' = (buf - bufxorg) /
bufxext
91
1
>u>nardy>map>window.pll, 03:09:04 Thursday April 28, 1983
window: procedure
(x origin, yorigin, x extent, yextent);
%include pdcl;
declare
$recalc
entry;
declare
x_origin
y origin
x extent
y_extent
float(23),
float(23),
float(23),
float(23);
unspec
(p) =
'000b000'b4;
p->q.Uwin.xorg
p->q.Uwin.yorg
p->q.Uwin.xext
p->q.Uwin.yext
call $recalc;
end;
=
=
=
=
x origin;
yorigin;
x extent;
y extent;
92
1
>u>nardy>map>port.pll, 03:09:54 Thursday April 28,
port:
procedure (xorigin, yorigin, x extent, yextent);
%include pdcl;
declare
$recalc
entry;
declare
x origin
y origin
x extent
y_extent
fix(15),
fix(15),
fix(15),
fix (15);
unspec
(p) = '000b0000'b4;
p->q.Uprt.xorg
x_origin;
p->q.Uprt.yorg
y_origin;
p->q.Uprt.xext = x_extent;
p->q.Uprt.yext = y extent;
call $recalc;
end;
1983
93
I
>u>nardy>map>tablet.pll, 03:13:04 Thursday April 28,
tablet: procedure
(xorigin, yorigin, x extent, yextent);
%include pdcl;
declare
$recalc
entry;
declare
x origin
y_origin
x-extent
y_extent
fix(15),
fix(15),
fix(15),
fix (15);
unspec
(p) = '000b0000'b4;
p->q.Utab.xorg
p->q.Utab.yorg
p->q.Utab.xext
p->q.Utab.yext
call $recalc;
end;
=
=
=
=
1983
x_origin;
y_origin;
x extent;
y extent;
94
1
>u>nardy>map>x_port.pll, 03:13:41 Thursday April
x_port:
procedure
28, 1983
(windowx) returns (fix(15));
%include pdcl;
declare window x float(23);
unspec
(p) =
'000b0000'b4;
return (p->q.prt.xorg +
(((window x - p->q.win.xorg) / p->q.win.xext) * p->q.prt.xext));
end;
95
I
>u>nardy>map>yport.pll, 03:14:06 Thursday April 28, 1983
y_port:
procedure
(windowy) returns
(fix(15));
%include pdcl;
declare window y float(23);
unspec
(p) =
'000b0000'b4;
return (p->q.prt.yorg +
(((window y - p->q.win.yorg) / p->q.win.yext) * p->q.prt.yext));
end;
96
1
>u>nardy>map>int.pIl, 03:21:50 Thursday April 28,
int: procedure
(portx, port y, int
1983
x, int_y, z);
%include pdcl;
declare
grin$vis
grin~pos
$rawxyz
entry (bit(16)),
entry (fix(15), fix(15),
entry (fix(15), fix(15),
declare
(x, y, z)
port x
port_y
curs x
curs y
int x
int y
float_x
float_y
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
float(23),
float(23);
/
fix(15)),
fix(15));
***********************************************************
unspec (p) = '000b0000'b4;
call $rawxyz (x, y, z);
if
z =>
0 then do;
float x = x;
float y = y;
x = p->q.win.xorg +
(((float_x - p->q.tab.xorg)
int_y = p->q.win.yorg +
(((floaty - p->q.tab.yorg)
int
/
p->q.tab.xext) * p->q.win.xext);
/
p->q.tab.yext) * p->q.win.yext);
/
p->q.win.xext) * p->q.prt.xext);
/
p->q.win.yext) * p->q.prt.yext);
float x = int x;
float y = int-y;
port-x = p->q.prt.xorg +
(((floatx - p->q.win.xorg)
port_y = p->q.prt.yorg +
(((floaty - p->q.win.yorg)
call grin$vis
call grin$pos
(p->q.cur vis);
(p->q.curnbr,
((portx -
((porty
end;
elsL do;
-
p->q.scale) + p->q.xoffset,
p->q.buf.yorg) * p->q.scale) + p->q.yoffset);
p->q.buf.xorg) *
97
2
>u>nardy>raap>int.pll
call grin$vis ('0000'b4);
portx = 0;
porty = 0;
int_x = 0;
int
y = 0;
end;
end;
proportions underlying equations:
(tabx - tabxorg) / tabxext = (winx - winxorg) / winxext
(prtx - prtxorg) / prtxext = (winx - winxorg) / winxext
(cuLx - curxorg) / curxext = (winx - winxorg) / winxext
98
1
>u>nardy>map>fp.pll, 03:19:42 Thursday April 28,
1983
fp: procedure (portx, port_y, fpx, fpy, z);
'include p dcl;
declare
grin$vis
grin$pos
$rawxyz
entry (bit(16)),
entry (fix(15), fix(15),
entry (fix(15), fix(15),
declare
(x, y, z
port_x
port_y
curs x
curs y
fp_x
fp_y
float x
float_y
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
float(23),
float(23),
float(23),
float(23);
/
fix(15) ),
fix(15));
*************************************/
unspec (p) = '000b0000'b4;
call $rawxyz (x, y, z);
if z =>
0 then do;
float x = x;
float y = y;
fpx = p->q.win.xorg +
(((float_x - p->q.tab.xorg)
fp_y = p->q.win.yorg +
(((float_y - p->q.tab.yorg)
portx = p->q.prt.xorg +
(((float_x - p->q.tab.xorg)
porty = p->q.prt.yorg +
(((floaty - p->q.tab.yorg)
/
p->q.tab.xext)
* p->q.win.xext);
/
p->q.tab.yext)
* p->q.win.yext);
/
p->q.tab.xext)
* p->q.prt.xext);
/
p->q.tab.yext)
* p->q.prt.yext);
call grin~vis (p->q.cur vis);
call grin~pos (p->q.cur nbr,
((port_x - p->q.buf.xorg) * p->q.scale) + p->q.xoffset,
((port_y - p->q.buf.yorg) * p->q.scale) + p->q.yoffset);
end;
else do;
call grin$vis ('0000'b4);
port
x =
0;
99
2
>u>nardy>map>fp.pll
porty = 0;
fpx = 0.0;
fpy = 0.0;
end;
end;
100
l
1983
>u>nardy>map>rawxyz.pll, 03:23:58 Thursday April 28,
raw_xyz:
procedure (x, y, z);
%include p_dcl;
declare
$ss
$wd
Srd
entry (bit(16), bit(8)),
entry (bit(16), bit(8)),
entry (bit(16), bit(8));
declare
i/o ports currently invert data from/to the tablet,
so active state of bits is 'O'b
bit(8) aligned init ('01101110'b), /* nextbyte set
next Lyte
byte received bit(S) aligned init ('10101110'b), /* byte rec'd set
bit(8) aligned init ('lll0lll0'b), /* nb&br reset
reset nbbr
bit(8),
garbage_byte
bit(8),
first byte
bit(8),
check byte
raw data [1:5] bit(8), /* holds all five bytes before converting to fix
bit(16) init ('00aa'b4), /* address of tablet port
tabaddr
x
y
z
delay
duration
far field
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
xbits
ybits
zbits
bit(16) defined x,
bit(16) defined y,
bit(16) defined z;
I
/*
/*
/*
*/
*/
delay loop counter
length of delay
cursor is in far field if > 500
/********************************************
unspec
(p) =
duration =
'000b0000'b4;
45;
call $ss (tabaddr, checkbyte);
if checK byte = '04'b4 then do;
x = 0; y = 0; zbits = 'fe'b4;
return;
end;
dc creck
do
byte
=
'ff'b4
while
(substr
(checkbyte,
first byte = 'ff'b4 while (substr
call Swd (tab addr, next byte);
1,
1)
(first-byte,
~=
1,
'O'b);
1)
~
b);
*
*
*
*
*
101
2
>u>nardy>map>raw xyz.pll
far field = 0;
do garbagebyte = 'ff'b4 while (substr (garbage_byte, 2, 1));
call $rd (tab_addr, garbage_byte);
far field = far field + 1;
if far field > 500 then do;
x = 0;
y = 0;
zbits = 'ffff'b4; /* won't take a fixed number. why?
return;
end;
end;
do delay = 1 to duration;
end;
call $wd (tab addr, reset nbbr);
call $rd (tabaddr, first byte);
call $wd (tab addr, byte received);
do garbage byte = '00'b4 while (^substr (garbage_byte, 2, 1));
call $rd (tabaddr, garbagebyte);
end;
call $wd (tabaddr, resetnbbr);
end;
rawdata [1] = firstbyte;
do i = 2 to 5;
call Swd (tab addr, next byte);
do garbage byte = 'ff'b4 while (substr (garbagebyte, 2, 1));
call $rd (tabaddr, garbage_byte);
end;
do delay = 1 to duration;
end;
call $wd (tab addr, reset nbbr);
call Srd (tab addr, raw data [i]);
call Swd (tab addr, bytereceived);
do garbage_byte = '00'b4 while (^substr (garbage_byte, 2, 1));
call Srd (tabaddr, garbagebyte);
end;
call $wd (tabaddr, resetnbbr);
end;
call Swd (tab addr, next-byte);
far-field = 0;
do garbagebyte = 'ff'b4 while (substr (garbage-byte, 2, 1));
call Srd (tab addr, garbagebyte);
far field = far field + 1;
if farfield > 500 then do;
X
y
=
zbits =
return;
'ffff'b4;
*/
102
3
>u>nardy>nap>rawxyz.pll
end;
end;
do delay = 1 to duration;
end;
call $wd (tab addr, reset nbbr);
call $rd (tab addr, check byte);
call Swd (tab addr, byte received);
do garbagebyte = '00'b4 while (^substr (garbagebyte, 2, 1));
call $rd (tabaddr, garbagebyte);
end;
call Swd (tabaddr, resetnbbr);
end;
xbits =
ybits =
zbits =
substr
substr
substr
substr
substr
xbits =
ybits =
zbits =
'ffff'b4;
'ffff'b4;
'ffff'b4;
(zbits, 13, 4)
substr (raw
(xbits, 11, 6) = substr (raw
(xbits,
5, 6) = substr (raw
(ybits, 11, 6) = substr (raw
(ybits, 5, 6) = substr (raw
data
data
data
data
data
[1],
[2],
[3],
[4],
[5],
3,
3,
3,
3,
3,
4);
6);
6);
6);
6);
~xbits;
~ybits;
~zbits;
if p->q.tab.xext > 0 then do;
if x < p->q.tab.xorg then x
else if x > p->q.tab.xorg +
then x = p->q.tab.xorg
end;
else do;
if x > p->q.tab.xorg then x
else if x < p->q.tab.xorg +
then x = p->q.tab.xorg
end;
if p->q.tab.yext > 0 then do;
if y < p->q.tab.yorg then y
else if y > p->q.tab.yorg +
then y = p->q.tab.yorg
end;
else do;
if y > p->q.tab.yorg then y
else if y < p->q.tab.yorg +
then y = p->q.tab.yorg
end;
= p->q.tab.xorg;
p->q.tab.xext - 1
+ p->q.tab.xext - 1;
= p->q.tab.xorg;
p->q.tab.xext - 1
+ p->q.tab.xext - 1;
= p->q.tab.yorg;
p->q.tab.yext - 1
+ p->q.tab.yext -
1;
= p->q.tab.yorg;
p->q.tab.yext - 1
+ p->q.tab.yext - 1;
103
4
end;
>u>nardy>map>raw_xyz.pll
104
APPENDIX II
Source code for menu package
105
1
>u>nardy>menu>menu.bind, 14:36:47 Tuesday April 26,
1983
menu
(menu: entry) calls all other programs:
menu-creator
file handling procedures:
create menu seg
inittextseg
chops up menu into separate sections:
partfinder
make linked lists and
fill in menu data structure:
prompt list-maker
portmaker
tree maker
add-tree-node
optionmaker
rigure_xy
read data structure to confirm
data is saved properly
prompt list writer
portwriter
tre writer
106
1
>u>nardy>menu>menudcl.incl.pll, 14:41:51 Tuesday April 26, 1983
declare
menu_ptr
1 menu seg
2 leaf-prefix
2 pop_up_mode
2 menu color,
3~ov8
3 ov9
3 ovlO
2 ground_port,
3 x abs
3 y abs
3 x rel
3 y rel
3 x ext
3 y ext
3 x ch
3 y ch
3 w ch
3 h ch
3 outline
3 txtmode
3 planes
2 menu_port
2 item_port
2 title_port
2 prompt_port
2 rootdata
2 root menu
2 menu-area
pointer,
based (menuptr),
bit(l),
bit(l),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
bit(16),
bit(16),
like ground_port,
like ground_port,
like ground_port,
like ground_port,
pointer,
pointer,
area (16000);
107
1
>u>nardy>menu>menu item_dcl.incl.pll, 14:42:44 Tuesday April 26,
declare
new menu
1m
2 firstitem
2 live-item
pointer,
based (newmenu),
pointer,
pointer,
to
1 item
pointer,
based (to),
pointer,
pointer,
pointer,
pointer,
iix(15),
fix(15);
2
2
2
2
2
2
label
content
right
left
x
y
1963
108
1
>u>nardy>meriu>mcnu creator.pll, 14:37:52 Tuesday April 26,
menu creator:
menu:
1983
procedure;
entry ();
%include menudcl;
%include menu item dcl;
declare
(answer)
(ioa, askn)
tmr
scs$get_arg_count
scs$get_arginfo
scs$expandpath
char(l)vary,
entry options (variable),
entry
entry
entry
entry
hcs$ terminate
options (variable),
(fix(15)),
(fix(15), bit(16), fix(15), pointer),
(char(168)vary, char(168)vary, char(32)vary,
fix(31)),
entry (pointer),
Sinit text_seg
screate menuseg
Spartfinder
entry (char(168)vary, char(32)vary, pointer, tix(15)),
entry (char(168)vary, char(32)vary, pointer),
entry (ptr, ptr, ptr, ptr, fix(15), fix(15), bit(l)),
Spromptlistmaker
Sport maker
Strec-maker
Soption_maker
$port-writer
$prompt list writer
tree writer
Sfigurexy
entry
entry
entry
entry
entry
entry
entry
entry
parts
start
s [1:5]
finish
f [1:5]
key
k [1:5]
fix(15) init (4),
pointer,
fixed(15) based (start),
pointer,
fixed(15) based (finish),
pointer,
char(16)vary based (key),
numargs
argtype
arglength
argptr
arg-string
fix(15),
dir name
entry_name
menu name
garbage-name
char(168)vary,
char(32)vary,
char(32)vary,
(pointer,
(pointer,
(pointer,
(pointer,
(pointer),
(pointer),
(pointer),
pointer,
pointer,
pointer,
pointer,
(fix(15),
fix(15), pointer, pointer),
bit(16),
fix(15),
pointer,
char(32) based
char(32)vary,
(arg_ptr),
pointer,
fix(15),
pointer,
fix(15),
fix(15), fix(15)),
fix(15)),
fix(15), fix(15)),
fix(15)),
109
2
>u>nardy>menu>menu creator.pll
textptr
headptr
pointer,
pointer,
i
char count
syscode
fix(15),
fix(15),
fix(31),
text menu-error
bit(l),
oops
condition;
/*****************************************************************/
on oops begin;
goto exit;
end;
call scs~get argcount (num-args);
if num args = 0 then call askn ("name of menu: ", menu-name);
else do;
call scs~getarginfo (1, arg_type, arglength, arg_ptr);
menu-name = substr (arg_ptr->arg_string, 1, arglength);
end;
if substr (menuname, length (menuname) - 4, 5) = ".menu"
then menu-name = substr (menu_name, 1, length (menuname)
entry name = menu name || ".menu";
if num args = 2 then do;
call scs$get arg info (2, arg type, arglength, arg ptr);
if substr (arg_ptr->arg string, 1, arglength) = "special"
then unspec (menuptr) = '000aO000'b4;
end;
else unspec (menu_ptr) = '000c0000'b4;
call scs$cxpandpath
call Sinit textseg
call Screate_menuseg
allocate s;
allocate f;
allocate k;
do i = 1 to parts;
start->s[il
finish->f[i]
= -1;
= -1;
end;
key->kl]
=
key->k[2]
= "**MENU";
"**PROMPTS";
-
5);
(menuname, dirname, garbagename, syscode);
(dir name, entryname, textptr, char-count);
(dir name, menu-name, menuptr);
110
3
>u>nardy>menu>menu creator.pll
key->k[3] = "**OPTIONS";
key->k[4] = "**PORTS";
call Spartfinder
(textptr, start, finish, key, parts, char-count, text menu error);
if (
text-menu error) then do;
call Sprompt list maker
(menu_ptr, textptr, head_ptr, start->s[l], finish->f[l]);
call Sprompt list writer (head ptr);
call $portmaker (menuptr, text_ptr, start->s[4], finish->f[4]);
call $portwriter (menu_ptr);
call $treemaker
(menuptr, textptr, headptr, start->s[2], finish->f[2]);
call Soption_maker (menuptr, textptr, start->s[3], finish->f[3]);
call $figure_xy
(0, -1, menu ptr->menu seg.root menu->m.first item, menu ptr);
call ioa ("r^r******************** MENU *********************r");
call Streewriter (menuptr->menuseg.root-menu->m.first item);
end;
call hcs$terminate (text_ptr);
call hcs$terminate (menuptr);
free s;
free t;
free k;
exit:;
end;
ill
1
>u>nardy>menu>create menu seg.pll, 14:44:17 Tuesday April 26,
create_menu_seg: procedure
1983
(dirname, menufile, menu_ptr);
declare
ioa
entry options (variable),
corm error
entry options (variable),
hcs$append_seg entry (char(168)vary, char(32)vary, fix(31)),
hcs$initiate_w_options
entry (char(168)vary, char(32)vary, char(32)vary,
bit(l), pointer, fix(31)),
dir name
char(168)vary,
menu-file
char(32)vary,
menu_ptr
pointer,
syscode
fix(31),
oops
condition;
syscodemanager: procedure (string);
declare string char(64)vary;
call com error (syscode, "createmenu_seg", string);
signal oops;
end;
on oops begin;
goto exit;
end;
call hcs$append seg (dir name, menu-file, syscode);
if syscode ~= -14 then do;
if syscode < 0 then call syscode manager ("making " || menu file);
else call ioa ("--> new menu file '^a' added to directory 'wa'",
menu file, dirname);
end;
else call ioa ("--> menu file '^a' already exists. you are bashing it",
menufile);
call hcs$initiate w options
(dir name, menu-file, menufile, 'l'b, menuptr, syscode);
if syscode < 0 then call syscode manager ("initiating " || menu file);
else call ioa ("--> menu file '^a' has been initiated at address ^p",
menu-file, menuptr);
exit:;
end;
112
1
>u>nardy>menu>inittext seg.pll, 14:45:46 Tuesday April 26, 1983
inittextseg:
procedure
(dirname, text-file, textptr, charcount);
declare
ioa
entry options (variable),
com_error
entry options (variable),
hcs$get bitcount entry (pointer, fix(31)),
hcs~initiate
entry (char(168)vary, char(32)vary, ptr, fix(31)),
dir name
char(168)vary,
text file
char( 32)vary,
textptr
pointer,
syscode
fix(31),
bit count
fix(31),
charcount
fix(15),
oops
condition;
syscodemanager: procedure (string);
declare string char(64)vary;
call com error (syscode, "init textseg", string);
signal oops;
end;
on oops begin;
goto exit;
end;
call
hcs$initiate
(dir name, text-file, text ptr, syscode);
if
syscode < 0 then call syscode manager ("initiating " 1i text file);
else call ioa ("--> text file '^a'
has been initiated", text-file);
call hcs$get bit count (text ptr, bit count);
char-count =
exit:;
end;
bit-count
/
8;
113
1
>u>nardy>menu>parttfinder.pll, 14:46:44 Tuesday April 26, 1963
--------------- ------------------------------------------
partfinder:
procedure
(text, start, finish, key, parts, char count, error);
declare
(ioa, ioan)
(ask, askn)
entry options
entry options
start
s [l:l]
finish
f [1:1]
key
k L1:1]
pointer,
fix(15) based (start),
pointer,
fix(15) based (finish),
pointer,
char(16)vary based (key),
text
ascii string
end_ptr
prevendptr
pointer,
ciar(30000) based
pointer,
pointer,
fix15_ptr
fixl5
parts
charcount
garbagetvar
(i, j)
pointer,
fix(15) based (fixl5_ptr),
fix(15),
fix(15),
fix(15),
fix(15),
comment
yes
no
error
bit(l) init
bit(l) init
bit(l) init
bit(l),
answer
/
(variable),
(variable),
(text),
('O'b),
('l'b),
('O'b),
char(l);
*************************
***
******
************************/
prev_endptr = addr(garbagevar);
do i = 1 to charcount;
if substr (text->asciistring, i, 1) = "|" then comment = yes;
else if substr (text->ascii string, i, 1) =
then comment = no;
if
(~ comment) then if substr (text->ascii string, i, 2) = "
do j=
1 to parts;
if (substr (text->ascii string, i, length (key->k [j]))
= key->k [j])
then do;
start->s [ji = i + length (key->k [ji);
endptr = addr (finish->f [i);
end;
end;
prev_endptr->fixl5 = i - 1;
then do;
114
2
>u>nardy>menu>partfinder.pll
prev_end_ptr = endptr;
end;
end;
endptr->fixl5 = char-count;
error
do i
end;
'O'b;
1 to parts;
if start->s[i] > 0 then do;
call ioa ("start ^i
finish ^i", start->s[i], finish->f[i]);
call ioan ("^a", key->k[i]);
call ioan ('a", substr (text->ascii string,
start->s[i], finish->f[i] - start->s[i] + 1));
call askn ("--> is this part identified ok? (y/n) ", answer);
if answer = "n" then error = 'l'b;
end;
end;
115
1
>u>nardy>menu>promptlist_maker.pll, 14:48:54 Tuesday April 26, 1983
promptlistmaker:
procedure (menu_ptr, textptr, headptr, start, finish);
%include menu dcl;
declare
scs$allocn
entry (fix(31), pointer, area),
headptr
match_ptr
1 match
2 string
2 data
2 next
pointer,
pointer,
based (match ptr),
char(32)vary,
pointer,
pointer,
textptr
asciistring
ascii array [1:1]
pointer,
char(l) based,
char(l) based,
start
finish
stringstart
string_length
(i, j)
fix15
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15) based,
allocbytes
fix(31),
one char
somethingthere
yes
no
char (l)
bit(l),
bit(l) init
('l'b),
bit(1) init ('O'b);
/* string_length + 2 */
/*****************************************************************/
menu ptr->menuseg.menuarea = empty(;
headptr = null();
somethingthere = no;
stringlength = 0;
do i = start to finish;
one char = text ptr->ascii array [i];
if one char = "T" then do;
if something there then do;
string length = stringlength - 1; /* delete last <cr>
allocbytes = stringlength + 2;
call scs$allocn (allocbytes, match_ptr->match.data,
menuptr->menu_seg.menu_area);
match ptr->match.data->fixl5 = string-length;
*/
116
2
>u>nardy>menu>promptlist_maker.pll
do j = 1 to stringlength;
match ptr->match.data->ascii array [j + 21 =
textptr->asciiarray [stringstart + j - 1];
end;
end;
string_start
= i + 1;
string_length = -1;
end;
else if one char = "]" then do;
something there = yes;
allocate match;
match_ptr->match.string =
substr (textptr->asciistring, stringstart, string_length);
match_ptr->match.next = head-ptr;
head_ptr = match_ptr;
string_start = i + 2;
string_length = -2;
end;
string_length = stringlength + 1;
end;
string_length = stringlength
- 1; /* delete last
<cr> */
alloc bytes = stringlength + 2;
call scs$allocn (alloc_bytes, match_ptr->match.data,
menu_ptr->menuseg.menu area);
matchptr->match.data->fixl5 = stringlength;
do j = 1 to string length;
matchptr->match.data->ascii array [j + 2] =
text_ptr->ascii array [string_start + j - 11;
end;
ena;
117
1
>u>nardy>menu>portmaker.pll, 14:50:43 Tuesday April 26, 1983
port_maker:
procedure
(menuptr, textptr, start, finish);
%include menu dcl;
declare
text ptr
asciiarray [1:1]
pointer,
char(l) based
start
finish
start-line
fix(15),
fix(15),
fix(15),
fix(15),
j)
(i,
/*
**
**
(textptr),
ch
match-string
char(l),
char(16)vary,
done
yes
no
bit(1),
bit(l) init
('l'b),
bit(1) init ('0'b);
**
**
**
**
**
* ***
*****
**
* **
*****
**
***
*****
**
**
******
* **
***
next-char: procedure;
i = i + 1;
ch = text ptr->ascii array [i];
end;
string to fix: procedure returns (fix(15));
/* note: tried p1l built-in, but it didn't work very well */
declare fixvar fix(15);
fixvar = 0;
do while ((ch
if
else if
else if
else if
else if
else if
else
if
~
ch
ch
ch
ch
ch
ch
=
=
=
=
=
=
"O"1
"1"
"2"
"3"
"4"
"5"
ch = "6"
else if ch = "7"
else if ch = '8"
else
if ch =
"9"
call next char;
& (ch ~= "
then fixvar
then fixvar
then fixvar
then fixvar
then fixvar
then fixvar
then fixvar
then fixvar
then fixvar
then fixvar
=
=
=
=
=
=
=
=
=
=
"));
10 *
(10
(10
(10
(10
(10
(10
(10
(10
(10
fixvar;
fixvar)
fixvar)
fixvar)
fixvar)
fixvar)
fixvar)
fixvar)
* fixvar)
* fixvar)
*
*
*
*
*
*
*
+
+
+
+
+
+
+
+
+
1;
2;
3;
4;
5;
6;
7;
8;
9;
**
* **
118
2
>u>nardy>menu>portmaker.pll
end;
do while ((ch =
"
call nextchar;
end;
return (iixvar);
end;
(ch =-
")
/*****************************************************************/
string to bit:
procedure returns (bit(8));
7* tried pll built-in, but it didn't work very well */
declare
k
fix(15),
bitvar
bit(16);
bitvar = '0000'b4;
do k = 8 to 6 by -1;
if ch = "1" then substr (bitvar, k, 1) =''b;
call nextchar;
end;
return (bitvar);
end;
/* *
****
*****
***
***************************************
assign-ten: procedure
*********
(portptr);
declare
portptr
1 port
2 x abs
2 y abs
2 x-rel
2 y rel
2 xext
2 yext
2 x ch
2 y ch
2 w ch
2 h ch
2 outline
2 txtmode
2 planes
port ptr->port.x rel
port_ptr->port.yrel
portptr->port.xext
portptr->port.y_ext
portptr->port.x ch
pointer,
based,
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
bit(16),
bit(16);
=
=
=
=
=
stringto fix
string to fix
stringtofix
string_tofix
stringtofix
();
();
();
(;
();
119
3
>u>nardy>menu>portmuaker.pll
portptr->port.y-ch
port_ptr->port.w_ch
portptr->port.h_ch
portptr->port.outline
port_ptr->port.planes
end;
=
=
=
=
=
string tofix
stringto fix
string tofix
string to fix
string-to bit
();
(;
();
(;
(;
/*****************************************************************/
line = start;
start
done
=
no;
do while (done = no);
j = start line;
ch = text ptr->ascii array [ji;
do while ((j ~= finiih) & (unspec (ch)
j = j + 1;
ch = textptr->ascii array [j];
end;
if j = finish then done = yes;
13));
/* find the first non-space/tab char */
i = start line;
ch = text ptr->ascii array [i];
"");
do while ((ch = " ")~I (ch =
call next-char;
end;
if ch ~= "I" then
if ch = "*" then
if unspec (ch) ~= 13 then
do;
match string =
") & (ch
do while ((ch
match string = match-string ||
call nextchar;
end;
do while ((ch = " ") | (ch =
call nextchar;
end;
/* a comment line
/* begin next section */
*/
/* <cr> end of line
"));
ch;
/* assign structure values depending on match string */
if (substr (match string, 1, 6)) = "ground"
then call assign ten (addr(menu ptr->menuseg.ground_port));
else if (substr (match string, 1, 4)T = "menu"
then call assign ten (addr(menu ptr->menu seg.menuport));
else if (substr (match string, 1, 4)T = "item"
then call assign ten (addr(menu ptr->menu seg.itemport));
else if (substr (match string, 1, 5)T = "title"
then call assign-Ten (addr(menuptr->menu seg.title port));
120
4
>u>nardy>menu>portmaker.pll
else if (substr (match string, 1, 6)) = "prompt"
then call assign ten (addr(menuptr->menuseg.promptport));
end;
start line =
end;
/*
/*
j
+ 1;
calculate absolute screen positions for each port */
(not necessary to calculate abs for items)
menuptr->menu seg.groundport.xabs = menuptr->menu seg.ground_port.xrel;
menu_ptr->menu seg.groundport.yabs = menuptr->menu seg.ground_port.y_rel;
menuptr->menu seg.item-port.xabs =
menuptr->menu_seg.groundport.x abs + menu_ptr->menu_seg.menuport.xrel;
menuptr->menu seg.itemport.y_abs =
menuptr->menu_seg.ground_port.y abs + menu ptr->menu seg.menuport.y rel;
menu_ptr->menu seg.menuport.xabs =
menu_ptr->menu_seg.groundport.xabs +
menuptr->menu seg.menu_port.xrel;
menu_ptr->menu seg.menuport.y_abs =
menu ptr->menuseg.groundport.y abs +
menu_ptr->menuseg.menuport.y_rel;
menuptr->menu seg.title_port.xabs =
menu_ptr->menu_seg.ground_port.x abs +
menuptr->menu seg.titleport.xrel;
menu_ptr->menu seg.titleport.y_abs =
menuptr->menu_seg.ground_port.y_abs +
menuptr->menuseg.titleport.y_rel;
menuptr->menu seg.promptport.x abs =
menu ptr->menu_seg.ground_port.xabs +
menu_ptr->menu seg.prompt_port.xrel;
menuptr->menu seg.prompt_port.y_abs =
menuptr->menuseg.ground_port.y_abs +
menu_ptr->menuseg.promptport.y_rel;
7*
*/
11*
*/
calculate txtmode for ports
(txtmode is not used for groundport or menu_port)
menu ptr->ground port.txtmode = 'llll'b4;
= 'llll'b4;
menuptr->menuport-txtmode
menuptr->itemport.txtmode = '0000'b4;
it
menu ptr->itemport.w_ch > 15 then
substr (menuptr->item port.txtmode, 6, 1) =
if menu ptr->item port.h ch > 23 then
substr (menu ptr->itemport.txtmode, 5, 1) =
'1'b;
'1'b;
121
1
>u>nardy>menu>treemaker.pll, 15:52:57 Tuesday April 26,
treemaker:
procedure
(menuptr,
text_ptr,
headptr,
start,
1983
finish);
%include menudcl;
binclude menu item dcl;
declare
(ioa, ioan)
scs$allocn
Sadd_tree node
entry options (variable),
entry (fix(31), pointer, area),
entry (pointer, pointer, pointer),
from
auxiliary
pointer,
pointer,
space
tab
ret
ch
char(l) init
char(l) init
char(l),
char(l),
(i, j)
menulevel
space count
first legal
last_legal
start
finish
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
(done, quit)
leaf-bit
yes
no
bit(l),
bit(l),
bit(l) init
bit(l)
init
textptr
asciistring
ascii array [1:1]
pointer,
char(l) based,
char(l) based,
label ptr
contentptr
head ptr
pointer,
pointer,
pointer;
("
"1),
("
"1),
('l'b),
('O'b),
/*****************************************************************/
next-char: procedure;
i = i + 1;
ch = text ptr->ascii array [i];
end;
/*****************************************************************/
122
2
>u>nardy>raenu>tree
maker.pll
savestring: procedure
declare
scs$allocn
dataptr
allocbytes
fix num
fixT5
(dataptr);
entry (fix(31), pointer, area),
pointer,
fix(31),
fix(15),
fix(15) based;
fix num = lastlegal - first_legal + 1;
alloc bytes = fix num + 2;
call scs$allocn (allocbytes, dataptr, menuptr->menuseg.menu_area);
data ptr->fixl5 = fix num;
do j = first
legal to last
legal;
= "\\" then
if text-ptr->ascii array [j]
dataptr->ascii array [j - firstlegal + 3] = ret;
else dataptr->ascii array [j - first-legal + 3] =
textptr->ascii-array [j];
end;
end;
/ **p******e*
**********************
*
match and save: procedure (data_ptr);
declare
dataptr
(fixnum, j)
fix 15
str
len
matchptr
I match
2 string
2 data
2 next
match-string
pointer,
fix(15),
fix(15) based,
fix(15),
pointer,
based (match_ptr),
char(32)vary,
pointer,
pointer,
char(32)vary;
/* you can do this quod allocated vars stick around in
/* the linkage segment (e) after the procedure goes away
str len = last legal - firstlegal - 1;
match string = substr (textptr->ascii string,
first_legal+l, strlen);
do match ptr = headptr repeat matchptr->match.next
while (substr (match_ptr->match.string, 1, str len)
substr (matchstring, 1, strlen));
end;
data ptr = match ptr->match.data;
end;
*
/
123
3
>u>nardy>menu>treemaker.pll
/*****************************************************************/
ret
=
menu ptr->menuseg.root menu = null();
I = start;
call nextchar;
do done = no while (done = no);
/* determine the menu level by counting spaces/tabs */
menulevel = 0;
space count = 0;
do while ((ch = space) I (ch = tab));
if ch = tab then do;
menu-level = menu level + 1;
spacecount
0;
end;
else if ch = space then do;
space-count = spacecount + 1;
if space count = 5 then do;
menulevel = menu-level + 1;
space_count = 0;
end;
end;
call next-char;
end;
/* arrive here knowing menu-level and first non-space/tab char */
/* if ch is not carriage return or comment marker, work on the line */
if ch ~= ret then if ch ~= "I" then do;
/* find last_legal ch of label (delete trailing space/tabs)
firstlegal = i;
= i;
lastlegal
leaf bit = no;
do quit = no while (quit = no);
call next char;
then quit = yes;
if
ch =
then quit = yes;
else if ch =
then quit = yes;
else if ch = "[
:" then do;
else if ch =
quit = yes;
leaf bit = yes;
end;
else if ch = "|" then do;
quit = yes;
content_ptr = null();
end;
*/
124
4
>u>nardy>menu>treeZmaker.pll
else if ch = ret then do;
quit = yes;
contentptr = null();
end;
else if ch ~= space then if ch ~= tab then lastlegal =
end;
/
/* arrive here knowing firstlegal ch, last legal ch
if textptr->asciiarray [firstlegal] = "["
then call matchand save (labelptr);
else call save-string (labelptr);
*
/*
*/
*/
*/
*/
/*
arrive here with next non-space/tab ch & 3 options:
1. content ptr = null(): don't work on rest of line
2. ch = ":W: what follows is program name string
3. otherwise ch = "'" or '"'
or "[": prompt string
i;
if contentptr ~= null() then do;
if ch = ":" then do;
/* delete leading space/tabs *7
call next char;
do while ((ch = space) I (ch = tab));
call nextchar;
end;
firstlegal = i;
do quit = no while (quit = no);
call next char;
if
ch = ret
then quit = yes;
else if ch = "I"
then quit
yes;
else if ch = space then quit = yes;
else if ch = tab
then quit = yes;
end;
lastlegal = i - 1;
call save_string (contentptr);
end;
else do;
/* get and save prompt string:
you already have taken care of leading space/tabs
and you can include trailing ones, but your first char
is " or ' or [ and you don't want to include it *7
firstlegal
= i;
do quit = no while (quit = no);
call next char;
if
ch = ret then quit = yes;
else if ch = "I" then quit = yes;
else if ch = "'" then quit = yes;
else if ch ='"'
then quit = yes;
else if ch = "]" then quit = yes;
end;
125
5
>u>nardy>menu>tree maker.pll
last-legal = i;
if ch = "]' then call match and save (content_ptr);
else do;
firstlegal = firstlegal + 1;
last legal = i - 1;
call save-string (content_ptr);
end;
end;
end;
/* arrive here with menu level, labelptr, contentptr, leaf bit *
call scs$allocn (20, to, menu ptr->menu seg.menu area);
to->item.y
= menulevel~- 1; /* level -1 is not displayed *7
to->item.label
= labelptr;
to->item.content = content-ptr;
if leafbit = yes then to->item.right = null();
if
(menuptr->menuseg.rootmenu = null()) then do;
do;
call scs$allocn
(8, newmenu, menu_ptr->menuseg.menuarea);
new menu->m.first item = to;
new menu->m.live item = null();
end;
menu_ptr->menuseg.root menu = new-menu;
to->item.x = 0;
to->item.left = null();
end;
else call $add tree node (to, from, menuptr);
from = to;
end;
/* if necessary mop up rest of chars on line, find car return */
do while (ch ~= ret);
call next-char;
end;
if i => finish then done = yes;
else call nextchar;
end;
do while (to->item.left ~= null());
trom = to->item.left;
to->item.left = null();
to =
end;
end;
from;
126
>u>riardy>menu>addtreenode.pll, 15:55:21 Tuesday April 26, 1983
1
addtreenode:
procedure (to, from, menu_ptr);
%include menudcl;
binclude menu item-dcl;
declare
scs$allocn
from
entry (fix(31), pointer, area),
pointer;
/*****************************************************************/
if
(to->item.y > from->item.y) then do;
/* temporarily */
to->item.left = from;
/* permanently */
to->item.x = 0;
do;
call scs$allocn (8, new menu, menuptr->menu seg.menu area);
new menu->m.first item : to;
/* permanently */
/* permanently */
new menu->m.live item = null();
/* permanently */
from->item.right~= new-menu;
end;
end;
else do;
if to->item.y = from->item.y then do;
to->item.left = from->item.left;
from->item.left = to;
end;
else do; /* to->item.y < from->item.y */
do while (to->item.y < from->item.y);
to->item.left = from->item.left;
from->item.left = null();
from = to->item.left;
end;
to->item.left = from->item.left;
from->item.left = to;
end;
to->item.x = from->item.x + 1;
end;
end;
/* temporarily */
/* permanently */
/* temporarily */
/* permanently */
/* temporarily */
/* permanently */
/* permanently */
127
1
>u>nardy>menu>option maker.pll, 02:00:24 Thursday April 28, 1983
optionmaker:
procedure (menu_ptr, text_ptr, start, finish);
tinclude menu dcl;
declare
(ioa,
ioan)
entry options
(variable),
space
tab
ret
ch
char(l) init ("
char(l) init ('
char(l),
char(l),
(word_1, word_2)
char(16)vary,
i
first_legal
start
fix(15),
fix(15),
fix(15),
fix(15),
finish
"),
yes
bit(1),
bit(i) init ('l'b),
no
bit(1-L)
textptr
pointer,
asciistring
char(l)
asciiarray [1:1]
char(l) based;
(done, quit)
init
('0'b),
based,
next-char: procedure;
i = i + 1;
ch = text ptr->ascii array [i];
end;
/*****************************************************************/
nextword: procedure
declare
word
strlen
len =
char(16)vary,
fix(15);
= i;
firstlegal
str
(word);
0;
do quit = no while (quit = no);
call next char;
if ch = space then quit = yes;
128
2
>u>nardy>menu>option_maker.pll
if ch = tab then quit = yes;
if ch = ret then quit = yes;
if ch = "I" then quit = yes;
str len = str len + 1;
end;
word = substr (text ptr->ascii string,
end;
/*******
first legal,
str len);
****************************************************
code-color: procedure
(code);
declare code fix(15);
if word
if word
if word
if word
if word
if word
if word
if word
end;
/****
**
**
/* first:
2
2
2
2
2
2
2
2
= "black"
= "blue"
= "green"
= "cyan"
= "red"
= "magenta"
= "yellow"
= "white"
***************
then
then
then
then
then
then
then
then
code
code
code
code
code
code
code
code
*************
=
=
=
=
=
=
=
=
****
0;
0;
2;
3;
4;
5;
6;
7;
**
******
****
*******
***/
set up default values, which may be overidden by user
menu_ptr->menuseg.leafprefix = 'l'b;
menu_ptr->menuseg.pop_up_mode = 'lb
menu_ptr->menuseg.menucolor.ov8 = 0;
menu_ptr->menuseg.menu_color.ov9 = 0;
menu_ptr->menuseg.menucolor.ovlO = 0;
/* now, check for explicit values */
ret
i = start;
call nextchar;
do done = no while
(done = no);
/* find first non-space/tab character
do while ((ch = space) I (ch = tab));
call next-char;
end;
*/
/* if char is not <cr> or comment marker, then work on the line
if ch ~= ret then if ch ~= "I" then do;
*/
129
>u>nardy>menu>optionmaker.pll
call next word (word 1);
do while ((ch = space) I (ch = tab));
call next-char;
end;
call nextword (word_2);
if word 1 = "leaf prefix" then do;
if word_2 = "yes" then menuptr->menuseg.leaf prefix =
else menuptr->menu_seg.leaf_prefix = 'O'b;
end;
'l'b;
else if word_1 = "plane 8" then
call codecolor (menu_ptr->menu seg.menucolor.ov8);
else if word 1 = "plane 9" then
call code_color (menu ptr->menu_seg.menu_color.ov9);
else if word 1 = "plane 10" then
call code_color (menuptr->menuseg.menu_color.ovl0);
else if word 1 = "mode" then do;
if word_2 = "popup" then
menuptr->menuseg.pop_up_mode
else if word 2 = "pop-up" then
menu ptr->menuseg.popupmode
else if word 2 = "popup" then
menu ptr->menu_seg.pop_upmode
else if word 2 = "continuous" then
menu ptr->menuseg.popup mode
end;
end;
=
'l'b;
=
'1'b;
=
'l'b;
=
'0'b;
do while (ch ~= ret);
call next-char;
end;
if i => finish then done = yes;
else call nextchar;
end;
call ioa ("rOPTIONS:");
if menu ptr->rmenuseg.leaf prefix =
= no");
else call ioa ("leafprefix
'l'b then call ioa ("leafprefix
if menu ptr->nenuseg.pop up mode = 'l'b then call
ulse call ioa ("menumode = continuous");
i",
=
call ioa ("color code of plane 8
i",
call ioa ("color code of plane 9 =
call ioa ("color code of plane 10 = ^i",
ioa
yes");
("menu mode = pop-up");
menuptr->menuseg.menucolor.ov8);
menuptr->menu seg.menucolor.ov9);
renu ptr->menu seg.menu color.ovl);
130
4
>u> nardy>menu> option_raaker.pI1
call ioa
call ioa
end;
("(0=black, 1=blue,
2=green,
3=cyan, 4=red,
5=mag, 6=yel, 7=white)");
131
1
>u>nardy>menu>figure_xy.pll, 02:04:20 Thursday April 28, 1983
figure_xy:
procedure (param_x, param_y, head, menuptr);
%include menudcl;
%include menu item dcl;
declare
answer
askn
ioa
head
current
param x
paramy
item x
itemLy
item
char(l),
entry options (variable),
entry options (variable),
pointer,
pointer,
fix(15),
fix(15),
fix(15),
fix(15);
x = param_x -
1;
item-y = paramy;
do current = head repeat current->item.left while (current
item x = item x + 1;
if item x > (menu_ptr->menuseg.menu_port.xext /
menu_ptr->menu seg.item_port.xext) - 1 then do;
item x = 0;
itemy = itemy + 1;
end;
current->item.x = item x;
current->item.y = itemy;
end;
null());
null());
do current = head repeat current->item.left while (current
if current->item.right ~= null() then call figure_xy
(0, item_y + 1, current->item.right->m.first item, menuptr);
end;
end;
132
1
>u>nardy>menu>prompt list writer.pll, 02:05:29 Thursday April 26,
----------------- ---- -----------------------------------
1983
promptlist writer: procedure (headptr);
declare
(ioa, ioan)
entry options (variable),
head_ptr
match_ptr
1 match
2 string
2 data
2 next
pointer,
pointer,
based,
char(32)vary,
pointer,
pointer,
textptr
asciiarray [1:l]
pointer,
char(l) based (textptr),
prompt
stringlength
fixl5
i
char(1024),
fixed(31),
fix(15) based,
fix(15);
/***************
******
******************
*****
/
do match_ptr = headptr repeat match_ptr->match.next while
(match ptr
~=
null());
call ioa ("r------------------------------< match node >");
call ioa (
match ptr = ^p", matchptr);
call ioa ("
match_ptr->match.data = ^p", matchptr->match.data);
call ioa ("
match_ptr->match.string = [^a]", match_ptr->match.string);
stringlength
= match_ptr->match.data->fixl5;
call ioa ("matchptr->match.data->fixl5 = ^i",
matchptr->match.data->fixl5);
do i = 3 to stringlength + 2;
call ioan ("'a", match_ptr->match.data->asciiarray [i]);
end;
call ioa ("^rmatchptr->match.next = ^p", matchptr->match.next);
end;
end;
133
1
>u>nardy>menu>portwriter.pll, 02:13:07 Thursday April 28, 1983
port_writer:
procedure (menuptr);
%include menudcl;
one-port: procedure
(string, port ptr);
declare
string
ioa
portptr
1 port
2 x abs
2 y abs
2 x rel
2 y rel
2 x ext
2 y ext
2 x ch
2 y ch
2 w ch
2 h ch
2 outline
2 txtmode
2 planes
call
call
call
call
call
call
call
call
call
call
call
call
call
call
end;
call
call
call
call
call
end;
ioa
ioa
ioa
ioa
ioa
ioa
ioa
ioa
ioa
ioa
ioa
ioa
ioa
ioa
char(16)vary,
entry options (variable),
pointer,
based (portptr),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
bit(16),
bit(16);
("^r----------> ^a", string);
= i", portptr->port.xabs);
("
x_abs
= ^i", port ptr->port.y abs);
(
y abs
= ^i", port-ptr->port.x rel);
(" xrel
y rel
= ^i", port ptr->port.y rel);
("
= ^i", port ptr->port.x ext);
("
x ext
= ^i", port ptr->port.y ext);
(
y ext
= ^i", portptr->port.x ch);
("
x_ch
= ^i", port_ptr->port.ych);
("
y_ch
= ^i", portptr->port.w ch);
("
w ch
= ^i", port ptr->port.h ch);
("
h ch
outline = ^i", port-ptr->port.outline);
("
txtmode = ^h", port_ptr->port.txtmode);
(
("
planes = ^h", port_ptr->port.planes);
oneport ("ground",
oneport ("menu",
oneport ("item",
oneport ("title",
oneport ("prompt",
addr
addr
addr
addr
addr
(menuptr->menuseg.groundport));
(menu_ptr->menu_seg.menuport));
(menuptr->menuseg itemport));
(menuptr->menuseg.titleport));
(menu ptr->menuseg.prompt_port));
134
1
>u>nardy>menu>tree_writer.pll, 02:15:29 Thursday April 28, 1983
tree-writer: procedure
(to);
%include menu item dcl;
declare
(ioa, ioan)
auxiliary
i
str len
fix15
asciiarray [1:1]
call
ioa
entry options (variable),
pointer,
fix(15),
fix(15),
fix(15) based,
char(l) based;
(-----------------------------------------------------------
call ioa ("[item ^p] [item.left-> ^p]",
to, to->item.left);
call ioa ("[item.right-> ^p] [item.right->m.first item->
item.right, item.right->m.first item);
call ioa ("^ry: ^i
(x: ^i),
to->Ttem.y, to->item.x);
^p]",
call ioan ('LABEL^r');
str len = to->item.label->fixl5;
do i = 3 to str len + 2;
call ioan ("^a",
to->item.label->ascii array [i]);
end;
call
ioa
('');
call ioan ('CONTENT-r"');
if to->content ~= null() then do;
strlen = to->item.content->fixl5;
do i = 3 to str len + 2;
call ioan ("^a", to->item.content->ascii acray [i]);
end;
end;
if to->item.content ~= null() then call ioan (');
call
ioa
("");
if to->item.right = null() then
call ioa ("is a LEAF node (runs a procedure)");
else call ioa ("is a MENU node (puts up a new menu)");
if to->item.right ~= null() then do;
auxiliary = to->item.right->m.first item;
call treewriter (auxiliary);
end;
if to->item.left
= null() then call tree-writer
end;
(to->item.left);
135
APPENDIX III
Model menu
136
1
>u>nardy>profile>typ4.menu, 02:40:05 Tuesday May 3, 1983
**MENU
typ4 font processor
raw
file
1 dir:
init:
term:
draw
one:
all:
headers
file:
chars:
modify:
capture:
glyph
file
1 dir:
init
old:
init
new:
term:
draw
one:
all:
headers
file:
glyphs:
modify
name:
source:
date:
base:
x-hgt:
cap:
max-hwd:
last-nbr:
stats:
append:
chr
file
1 dir:
init
old:
init
new:
term:
draw
' [level one]
[raw]
[raw file]
raw dir
init raw
term raw
[raw draw]
oneraw char
all raw chars
[raw headers7
raw file stats
rawlist
modraw
contour
[glyph]
[glyph file]
glyphdir
init oldglyph
initnew
glyph
term glyph
[glyph draw]
drawglyph
al lglyphs
[glyph headers]
glyph file stats
glyph list
[glyph mod7
mod$glyph_name
mod$glyph_source
mod$glyphdate
mod$glyphbase
mod$glyphxhgt
mod$glyph_cap
mod$glyphmaxhwd
mod$glyphlastnbr
mod_glyphstats
appglyph
~
[chr]
[chr file]
chr dir
oldchr
init
init
new chr
term chr
[chr drawj
137
2
>u>nardy>profile>typ4.menu
one:
all:
headers
file:
chrs:
modify
name:
source:
date:
base:
x-hgt:
cap:
max-hwd:
last-nbr:
stats:
append:
write:
draw chr
all
chrs
[chr headers]
chr file stats
chr list
[chr mod]
change$chr_name
change$chr source
change$chr date
change$chrbase
change$chrxhgt
change$chrcap
change$chrmax hwd
change$chr last nbr
change_chr stats
append_char
write chr
lrn:
lrn
magic6:
magic6
**PROMPTS
[level one]
select option:
raw
g1yph
chr
lrn
magic6
.raw file operations
.glyph file operations
.chr file operations
list reference names
any magicsix command
[raw]
select option:
file
draw
headers
modify
capture
list, initiate, terminate
draw characters ons screen
list header information
change header information
use vidicon to digitize font
[raw file]
select option:
1 dir
init
term
list .raw directory
initiate .raw file
terminate .raw file
138
3
>u>nardy>profile>typ4.menu
[raw draw]
select option:
one
all
draw one
draw all
.raw character
.raw characters
[raw headers]
select option:
list .raw file header
list character headers
file
chars
[glyph]
select option:
file
draw
headers
modify
append
list, initiate, terminate
draw glyphs
list header information
change header information
add .raw chars to .glyph file
[glyph file]
select option:
1 dir
init old
init new
term
list .glyph directory
initiate existing .glyph file
create, initiate .glyph file
terminate .glyph file
[glyph draw]
select option:
one
all
draw one glyph
draw all glyphs
[glyph headers]
select option:
file
glyphs
list .glyph file header
list glyph headers
[glyph mod]
select option:
name
source
date
base
change
change
change
change
name of glyph-set
source of glyph-set
date
baseline
139
4
>u>nardy>profile>typ4.menu
x-hgt
cap
max-hwd
last-nbr
stats
change x-height
change cap height
change max hgt, width, depth
change number of last glyph
compute max-hgt -width -depth
[chr]
select option:
file
draw
headers
modify
append
write
list, initiate, terminate
draw chrs
list header information
change header information
add glyphs to .chr file
write with .chr font
[chr file]
select option:
1 dir
init
old
init
new
term
list .chr directory
initiate existing .chr file
create, initiate .chr file
terminate .chr file
[chr draw]
select option:
one
all
draw one chr
draw all chrs
[chr headers]
select option:
file
chr
list .chr file header
list chr header information
[chr mod]
select option:
name
source
date
base
x-hgt
cap
max-hwd
last-nbr
stats
**PORTS
change name of chr-set
change source of chr-set
change date
change baseline
change x-height
change cap height
change max hgt, width, depth
change number of last chr
compute max-hgt -width -depth
140
5
>u>nardy>profile>typ4.menu
ground
menu
item
title
prompt
I (chx,
x
y
0
0
16
16
0
0
448
16
16
256
chy) is the
chw
w
h
chx chy
512
480
0
0
0
480
224
0
0
0
80
24
7
5
9
480
32
16
1
18
480
192
0
150
9
starting location of type wrt
chh
0
0
12
24
16
its port
outl
0
0
1
0
0
(ergo
planes
001
001
001
001
001
150)
**OPTIONS
leafprefix
yes
plane_8
plane_9
plane_10
black
black
black
mode
pop_up
if "yes", puts a "*" before each leaf label
if "no", prints each label as is
(not used in this menu)
(not used in this menu)
color of lettering and boxes
legal overlay colors:
black, red, blue, green,
cyan, yellow, magenta, white
I choice: popup (=default), or continuous
141
APPENDIX IV
Source code for use package
142
1
>u>nardy>use>use.bind, 02:18:10 Thursday April 28,
1983
use
menu manager calls all other procedures
menu manager contains use: entry;
menu-manager
draw item
erase item
draw title
erase title
draw_prompt
erase_prompt
draw-menu
erase-menu
erase menuplanes
kill all livingthings
kill menu list
restore menu
before dollar
match finder
menu
init
143
1
>u>nardy>menu>menudcl.incl.pll, 02:53:49 Thursday April 28,
declare
menuptr
1 menu seg
2 leafprefix
2 popupmode
2 menucolor,
3 ov8
3 ov9
3 ovl
2 groundport,
3 xabs
3 yabs
3 xrel
3 yrel
3 xext
3 yext
3 xch
3 ych
3 wch
3 h ch
3 outline
3 txtmode
3 planes
2 menuport
2 item-port
2 titleport
2 promptport
2 rootdata
2 root_menu
2 menu-area
pointer,
based (menuptr),
bit(l),
bit(l),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
bit(16),
bit(16),
like groundport,
like groundport,
like groundport,
like groundport,
pointer,
pointer,
area (16000);
1983
144
>u>nardy>menu>menu item dcl.incl.pil, 02:54:42 Thursday April 28, 1983
I
declare-------------------------------------declare
new menu
1m
2 first-item
2 live-item
pointer,
based (newmenu),
pointer,
pointer,
to
1 item
pointer,
based (to),
pointer,
pointer,
pointer,
pointer,
fix(15),
fix(15);
2
2
2
2
2
2
label
content
right
left
x
y
145
1
>u>nardy>use>meronu_mianager.pll,
02:21:16 Thursday April 28,
-------------------------------------------------------
menumanager:
1983
procedure;
use: entry ();
%include menudcl;
binclude menu item dcl;
%include ma, dcl;
ceclare
(ioa, ioan)
askn
iocs$getc
scs$cl
scs$get_arg_count
scs$get_arginfo
scs$expand_path
entry
entry
entry
entry
entry
entry
entry
hcs$terminate
tmr
options (variable),
options (variable),
(char(l)),
options (variable),
(fix(15)),
(fix(15), bit(16), fix(15), pointer),
(char(168)vary, char(168)vary, char(32)vary,
fix(31)),
entry (pointer),
entry options (variable),
grin$ocolor
entry (fix, fix,
fix),
Sinit menu
entry (char(168)vary, char(32)vary, pointer),
$restore menu
entry (pointer),
$erase menuplanes
entry (pointer),
Skill_alllivinathings
entry (pointer),
Sdraw title
entry (pointer, bit(l), pointer),
$draw prompt
entry (pointer, bit(l), pointer),
$erase_prompt
entry (pointer),
menu
entry (pointer, pointer),
$match finder
entry (pointer, fix(15), fix(15),
pointer, pointer, pointer),
$beforedollar
entry (char(32)vary) returns (char(32)vary);
Sdraw
declare
num args
arg length
arg_type
argptr
argstring
dir name
entryname
rec name
menuname
garbagename
programname
fix(15),
fix(15),
bit(16),
pointer,
char(32) based (argptr),
char(168)vary,
char(32)vary,
char(32)vary,
char(32)vary,
char(32)vary,
char(32)vary,
146
2
>u>nardy>use>menu manager.pll
answer
asciiarray [1:1]
char (1),
char(l) based,
temp_y_float
temp x float
x flt items
y flt items
(fpx, fpy)
float(23),
float(23),
float(23),
float(23),
float(23),
x nuni items
y num items
x_numpixels
y_num pixels
y tabextent
(scrn _x, scrn_y)
(i, x, y, z)
str len
fix15_num
fix(15),
syscode
Qops
systemao
break
fix(31),
condition,
condition,
condition,
quitp
legalp
no
yes
normal
inverse
bit(1),
bit(1),
bit(l)
init
bit(l)
init
match item
match header
current
pointer,
pointer,
pointer;
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15) based,
(O'b)
('1 'b)
init ('0'b)
init ('1 'b)
bit(l)
bit(l)
/***************************
**
*****
*****************
on systeindo begin;
end;
on oops begin;
goto exit;
end;
on break begin;
call ioan ("^r--> confirm BREAK (y/n)
call iocs$getc (answer);
call
ioa
("^r");
if answer =
"y" then goto exit;
");
147
3
>u>nardy>use>menu manager.pll
end;
call scs$get_arg_count (numargs);
if num_args = 0 then call askn ("name of menu: ", menu name);
else do;
call scs$get_arg_info (1, arg_type, arglength, argptr);
menu name = substr (arg_ptr->arg_string, 1, arglength);
end;
unspec (menuptr) = '00Uc0000'b4;
call scs$expandpath (menuname, dirname, garbage_name, syscode);
call Sinit menu (dir_name, menuname, menu_ptr);
call grin~ocolor (menu_ptr->menu_seg.menucolor.ov8,
menuptr->menu seg.menucolor.ov9,
menu_ptr->menu seg.menu color.ovlO);
call map$setup;
call
call
ioan ("^r--> resume or fresh start?
iocs$getc (answer);
call
ioa
(r/s)
);
("");
if answer = "r" then call $restoremenu (menu_ptr);
else do;
current = menuptr->menu seg.rootmenu->m.first item;
menuptr->menu seg.rootmenu->m.live item = current;
call $kill all livingthings (current->item.right);
call $draw title
(current, inverse, menuptr);
call $drawprompt (current, normal, menuptr);
call $draw-menu
(current->item.right, menuptr);
end;
x-num items =
menuptr->menuseg.menuport.xext / menuptr->menu_seg.itemport.xext;
x flt items = x num items;
y_num items =
menuptr->menuseg.menuport.y_ext / menu_ptr->menu_seg.item_port.y ext;
y flt items
y_num-items;
x numpi-els = menuptr->menu seg.item port.x ext * x num items;
y num pixels = menuptr->menu seg.item-port.y ext * ynum-items;
temp_x float
x_numpixels;
temp_y_float
y_numpixels;
y_tab extent = (temp_y_float * 2000.0) / temp_x_float;
do quitp = no while (quitp = no);
call map$tablet (77, 601, 2048, y tab extent);
call miap~window (0,
0, x flt
items, y-flt
items);
call map~port (menuptr-rmenu seg.menu_port.xabs,
menuptr->imenu_seg.menuport.yabs, xnumpixels, ynumpixels);
do legalp = no while (legalp = no);
148
--------------------------------------------------4
>u>nardy>use>menu_manager.pll
------------------------------------------------------do z = 0 while (z < 1);
call map$fp (scrnx, scrn _y, fpx, fpy, z);
end;
do while
(z
~= 0);
call map$fp (scrnx, scrn_y, fp_x, fp_y, z);
end;
x = fp_x;
y = fp_y;
call $matchfinder (menu_ptr->menuseg.root menu,
x, y, match item, match header, menuptr);
if matchitem ~=~null() then legalp = yes;
end;
if quitp = no then do;
call $draw title (match item, inverse, menuptr);
call $eraseprompt (menu_ptr);
if match item->item.right = null() then do;
/* you are about to call a program-- now, you might break
out in the middle of it, so you have to prepare the menu
tree for that eventuality: first update title, then get
program name, then set live item pointed to by match header
to nullT): this sets you up-for restoring the menu to
how it was before you picked the last item */
programname = ""
strlen = match item->item.content->fixl5_num;
do i = 3 to str len + 2;
programname = programname i
match_item->item.content->asciiarray [i];
end;
7* anticipating successful completion of program: *7
match header->m.live item = null();
if menu ptr->menu_seg.pop_upmode = 'l'b
then call $erase menuplanes (menuptr);
call scs$cl (program name);
call tmr (before dollar(programname));
if menuptr->menuseg.pop_up mode = 'l'b
then call $erasemenu_planes (menu ptr);
call grin$ocolor (menuptr->menuseg.menucolor.ov8,
menuptr->menuseg.menucolor.ov9,
menu_ptr->menuseg.menucolor.ovO);
call $restore menu (menu ptr); /* makes match-item normal *
end;
else do;
call $drawprompt (matchitem, normal, menu_ptr);
call $draw menu
(match header->m.liveem->iitem.right, menu ptr);
end;
end;
ena;
149
5
>u>nardy>use>menu manager.pll
exit:
call Serase_menuplanes (menuptr);
call hcs$terminate (menu ptr);
call tmr ("mapparam_01");
end;
150
1
>u>nardy>use>draw_item.pll, 02:25:38 Thursday April 28,
1983
drawitem: procedure (instance, norm-inv, menu_ptr);
%include menu dcl;
%include menu item dcl;
declare
grin~rectv
grin$text
entry (fix, fix, fix, fix, bit(16),
fix),
entry (fix, fix, bit(16), char(1024)vary),
instance
pointer,
(xl, yl, x2, y2)
(i, x, y)
rightmargin
bottommargin
off
on
fix15
fix(15),
fix(15),
fix(15),
fix(15),
fix(15) init
(0),
fix(15) init
(1),
fix(15) based,
text mode
norminv
bit(16),
bit(l),
ascii array [1:1]
ret
onechar
ascii num
char(l) based,
char(l),
char(l),
fix(7) defined one-char;
**********
/* normal = '0'b, inverse =
'l'b */
*******************************************************/I
/* first, do the box */
xl = menu-ptr->menuseg.item_port.xabs +
(instance->item.x * menuptr->menu_seg.item_port.xext);
yl = menuptr->menuseg.itemport.y_abs +
(instance->item.y * menu_ptr->menu_seg.item_port.y_ext);
x2 = xl + menuptr->menu seg.itemport.x ext - 2;
y2 = yl + menu_ptr->menuseg.item_port.y-ext - 2;
x = xl + menuptr->menu_seg.item_port.xch;
y = yl + menu_ptr->menu_seg.item_port.y_ch;
call grinirectv (xl,
if
norm
xl
yl
x2
y2
yl, x2, y2, menu_ptr->menuseg.itemport.planes, on);
inv = 'O'b then do;
/* normal */
= xl + menuptr->menuseg.item_port.outline;
= yl + menuptr->menuseg.itemport.outline;
= x2 - menuptr->menuseg.item_port.outline;
= y2 - menuptr->menuseg.itemport.outline;
151
2
>u>nardy>use>draw item.pll
call grin$rectv
(xl, yl, x2,
end;
y2,
menu_ptr->menuseg.item_port.planes,
off);
right margin = x2;
bottom_margin = yl;
/* next, do the characters */
ret
=
text mode = menu ptr->menuseg.itemport.txtmode;
substr (textmode, 1, 1) = norm inv;
if menu ptr->menu_seg.leaf prefix = 'l'b then
if instance->item.right = null() then do;
call grin$text
(x, y,
text mode,
"*");
x = x + menuptr->menuseg.item-port.w_ch;
end;
do i = 3 to instance->item.label->fixl5 + 2;
one char = instance->item.label->ascii array [i];
if ((ascii num > 95) & (ascii num < 127)) then
ascii-num = ascii num - 32;
then x = x + menu ptr->menu seg.item port.w ch;
if one char =
then
/*~sleazy-tab */
else if one char = "
x = x + 5 * menu ptr->menuseg.item-port.wch;
else if one char = ret then do;
x = menuptr->menu_seg.itemport.xabs +
menuptr->menuseg.item_port.xch;
y = y - menuptr->menu seg.itemport.h_ch;
end;
else do;
if (x + menu ptr->rnenuseg.item port.w ch < rightmargin) then
if (y > bottommargin) then do;
call grintext (x, y, text-mode, onechar);
x = x + menuptr->menu seg.itemport.w ch;
end;
end;
end;
end;
152
1
>u>nardy>use>erase item.pll,
erase_item:
procedure
(instance,
02:27:53 Thursday April 28, 1963
menuptr);
%include menudcl;
9include menu item dcl;
declare
*******
grin$rectv
entry (fix, fix,
instance
pointer,
(xl, yl, x2, y2)
off
on
fix(15),
fix(15) init (0),
fix(15) init (1);
*************************
******
fix, fix, bit(16),
fix),
*************************/
xl = menu ptr->menuseg.item port.xabs +
(instance->item.x * menuptr->menuseg.itemport.xext);
yl = menuptr->menuseg.item_port.y_abs +
(instance->item.y * menuptr->menu_seg.item_port.y_ext);
x2 = xl + menuptr->menu_seg.item_port.xext - 2;
y2 = yl + menuptr->menu_seg.itemport.y_ext - 2;
call grin~rectv (xl, yl, x2, y2, menuptr->menu_seg.item port.planes, off);
end;
153
I
>u>nardy>use>draw title.pll,
02:28:39
Thursday April 28, 1983
draw-title: procedure (instance, norm inv, menu ptr);
%include menu dcl;
%include menu item dcl;
declare
ioa
grin$rectv
grin$text
entry options (variable),
entry (fix, fix, fix, fix, bit(16), fix),
entry (fix, fix, bit(16), char(1024)vary),
instance
pointer,
(xl, yl, x2, y2)
(i, x, y)
right margin
bottom_margin
off
on
fix15
fix(15),
fix(15),
fix(15),
fix(15),
fix(15) init
(0),
fix(15) init
(1),
fix(15) based,
text mode
norm inv
bit(16),
bit(l),
ascii array
ret
one-char
ascii num
[1:l]1
/* normal =
'O'b, inverse =
'l'b *
char(l) based,
char(l),
char(l),
fix(7) defined one-char;
/*****************************************************************/
7*
xl
yl
x2
y2
x =
first,
do the box */
menuptr->menu_seg.title_port.xabs;
menuptr->menuseg.title_port-y_abs;
xl + menu_ptr->menuseg.titleport.x_ext yl + menuptr->menu seg.title_port.y ext -
2;
2;
ml + menuptr->menuseg.title_port.xch;
y = yl
+ menu-ptr->menu_seg.title-port.y-ch;
call grin$rectv (xl,
yl, x2, y2, menuptr->menuseg.titleport.planes, on);
/* normal */
if norm inv = 'O'b then do;
xl = xl + menuptr->menuseg.titleport.outline;
yl = yl + menuptr->menu_seg.titleport.outline;
x2 = x2 - menuptr->menuseg.titleport.outline;
y2 = y2 - menu ptr->menu seg.titleport.outline;
call grin$rectv
154
2
>u>nardy>use>draw title.pll
(xl, yl, x2,
y2, menuptr->menu seg.title_port.planes, off);
end;
rightmargin
= x2;
bottommargin = yl;
/* next, do the characters */
ret =
textmode = menuptr->menu_seg.title_port.txtmode;
substr (textmode, 1, 1) = norm inv;
if menu ptr->menu seg.leafprefix = 'l'b then
if instance->item.right = null() then do;
call grin$text (x, y, textmode, "*");
x = x + menuptr->menu_seg.title_port.wch;
end;
do i = 3 to instance->item.label->fixl5 + 2;
one char = instance->item.label->ascii array [i;
if T(ascii num > 95) & (ascii num < 127)) then
ascii num = ascii num - 32;
if one char = " " then x = x + menu ptr->menu seg.titleport.w ch;
/* sleazy-tab */
" then
else if one char = "
x = x + 5 * menu-ptr->menuseg.titleport.w ch;
else if one-char = ret then do;
x = menu-ptr->menuseg.titleport.xabs +
menuptr->menu_seg.titleport.x_ch;
y = y - menuptr->menuseg.title_port.h_ch;
end;
else do;
if (x + menu-ptr->menuseg.titleport.w_ch < rightmargin) then
if (y > bottom margin) then do;
call grin$text (x, y, textmode, onechar);
x = x + menu ptr->menu seg.title port.w ch;
end;
end;
end;
end;
155
1
>u>nardy>use>erasetitle.pll, 02:30:32 Thursday April 28,
erase-title:
1983
procedure (menuptr);
%include menudcl;
declare
grin$rectv
entry (fix,
(xl,
off
on
fix(15),
fix(15) init
fix(15) init
yl,
x2, y2)
fix,
fix, fix, bit(16),
fix),
(0),
(1);
S*****************************************************************/
xl
y1
x2
y2
= menu_ptr->menuseg.titleport.x_abs;
= menu ptr->menu_seg.title port.y_abs;
= xl + menuptr->menuseg.title port.xext = yl + menu_ptr->menu_seg.title_port.y_ext -
2;
2;
call grin$rectv (x1, yl, x2, y2, menu ptr->menu_seg.title_port.planes, off);
end;
156
1
>u>nardy>use>drawprompt.pll, 02:31:02 Thursday April 28,
draw_prcmpt: procedure
1983
(instance, norm-inv, menuptr);
%include menudcl;
%include menu item dcl;
declare
7*
xl
yl
x2
y2
ioa
grin$rectv
grin$text
entry options (variable),
entry (fix, fix, fix, fix, bit(16), fix),
entry (fix, fix, bit(16), char(1024)vary),
instance
pointer,
(xl, yl, x2, y2)
(i, x, y)
right margin
bottom_margin
off
on
fix15
fix(15),
fix(15),
fix(15),
fix(15),
fix(15) init
(0),
fix(15) init
(1),
fix(15) based,
text mode
norm inv
bit(16),
bit(l),
ascii array [1:1]
ret
one char
ascii_num
char(l) based,
char(l),
char(l),
fix(7) defined one-char;
/* normal =
'0'b, inverse =
'l'b */
first, do the box */
menu_ptr->menu seg.promptport.xabs;
menu_ptr->menu_seg.prompt_port.y_abs;
xl + menu_ptr->menu_seg.promptport.xext yl + menuptr->menu_seg.promptport.y_ext -
2;
2;
x = xl + menu_ptr->menu_seg.prompt_port.xch;
y = yl + menu_ptr->menu_seg.prompt_port.y_ch;
/*
call grin$rectv (xl,
*7
if
yl, x2, y2, menu ptr->menu seg.prompt port.planes, on);
norm inv = 'O'b then do;
/* normal */
xl = xl + menuptr->menu seg.promptport.outline;
yl = yl + menu_ptr->menu seg.prompt_port.outline;
x2 = x2 - menuptr->menu seg.promptport.outline;
y2 = y2 - menuptr->menu seg.promptport.outline;
call grin$rectv
157
2
>u>nardy>use>draw_prompt.pll
(xl,
yl, x2, y2, menuptr->menu seg.promptport.planes, off);
end;
rightmargin = x2;
bottom_margin = yl;
/* next, do the characters */
ret
=
text mode = menuptr->menu seg.prompt_port.txtmode;
substr (textmode, 1, 1) = norm-inv;
do i = 3 to instance->item.content->fixl5 + 2;
one char = instance->item.content->ascii array [i];
if T(ascii num > 95) & (ascii num < 127)T then
ascii-num = ascii num - 32;
if one char = "
then x = x + menuptr->menu_seg.promptport.w ch;
else if one char = "
then /* sleazy-tab */
x = x + 5 * menuptr->menuseg.prompt_port.wch;
else if one-char = ret then do;
x = menu ptr->menuseg.prompt_port.xabs +
menu_ptr->menu_seg.prompt_port.xch;
y = y - menu_ptr->menuseg.prompt_port.hch;
end;
else do;
if (x + menuptr->menuseg.promptport.wch < right_margin) then
if (y > bottom-margin) then do;
call grin$text (x, y, textmode, onechar);
x = x + menu ptr->menu seg.prompt_port.w ch;
end;
end;
end;
end;
158
1
>u>nardy>use>erase_prompt.pll, 02:32:51 Thursday April 28, 1983
erase-prompt: procedure
(menuptr);
%include menu dcl
declare
grin$rectv
(xl, yl, x2, y2)
off
entry (fix, fix, fix,
fix(15),
fix(15) init (0);
fix, bit(16),
fix),
/ ******************************************
xl = menuptr->menuseg.prompt_port.x_abs;
yl = menu_ptr->menu_seg.prompt_port.y_abs;
x2 = xl + menuptr->menuseg.promptport.x ext y2=yl + menu_ptr->menu_seg.prompt_port.y_ext -
2;
2;
call grin$rectv
(xl, yl, x2, y2, menu ptr->menu seg.promptport.planes, off);
end;
159
I
>u>nardy>use>drawmenu.pll, 02:33:45 Thursday April 28, 1983
draw_menu: procedure
(new-menu, menuptr);
%include menudcl;
%include menu item dcl;
declare
$draw-item
itemptr
normal
inverse
entry (pointer, bit(l), pointer),
pointer,
bit(l) init ('0'b),
bit(l) init ('l'b);
do item-ptr = new menu->m.first item
repeat itemptr->item.left while (item_ptr ~= null());
if item ptr = new menu->m.live item then
call $draw item (item_ptr, inverse, menu_ptr);
else call $draw-item (itemptr, normal, menu ptr);
end;
end;
160
1
>u>nardy>use>erasemenu.pll, 02:34:52 Thursday April 28,
erase-menu: procedure (new-menu, menuptr);
%include menudcl;
tinclude menu item dcl;
declare
$erase-item
itemptr
normal
inverse
entry (pointer, pointer),
pointer,
('O'b),
bit(l) init
bit(l) init
('l'b);
do item ptr = new menu->m.first item
repeat item_ptr->item.left while (item ptr
call Serase-item (item_ptr,
end;
end;
menuptr);
null());
1983
161
1
>u>nardy>use>erasemenuplanes.pll, 02:42:15 Thursday April 28,
eras=_menu_planes:
1983
procedure (menuptr);
%include menudcl
check: procedure (pos, bit str);
declare
grin$rectv entry (fix, fix, fix, fix, bit(16),
off
fix(15) init (0),
fix(15),
pos
bitstr
bit(16);
fix),
if substr (menu_ptr->menuseg.ground_port.planes, pos, 1) = 'l'b
then call grin$rectv (0, 0, 511, 511, bitstr, off);
else if substr (menu-ptr->menu-seg.menu port.planes, pos, 1) = '1'b
then call grinrectv (0, 0, 511, 511, bitstr, off);
else if substr (menu ptr->menu_seg.item-port.planes, pos, 1) = 'l'b
then call grin$rectv (0, 0, 511, 511, bitstr, off);
else if substr (menu_ptr->menu_seg.titleport.planes, pos, 1) = 'l'b
then call grin$rectv (0, 0, 511, 511, bit str, off);
else if substr (menu ptr->menuseg.prompt_port-planes, pos, 1) = 'l'b
then call grin$rectv (0, 0, 511, 511, bitstr, off);
end;
S********
** *******************************************************/
call check (6, '0400'b4);
call check (7, '0200'b4);
call check (8, '0100'b4);
end;
162
I
>u>nardy>use>kill all living_things.pll,
02:35:20 Thursday April 26, 191
kill all living_things: procedure (newmenu);
%include menuitemdcl;
declare item-ptr pointer;
if
new menu->m.live item ~= null()
then new-menu->m.live item = null();
do item ptr = new menu->m.firstitem repeat itemptr->item.left
while (item_ptr ~= null());
if item ptr->item.right ~= null()
then call kill all livingthings (itemptr->item.right);
end;
end;
163
1
>u>nardy>use>kill menu list.pll, 02:36:07 Thursday April 28, 1983
kill menu list: procedure (newmenu, menu ptr);
%include menudcl;
%include menu item dcl;
declare
next menu
$erase-menu
pointer,
entry (pointer, pointer);
call Serase-menu (newmenu, menuptr);
if new menu->m.live item ~= null() then do;
if newmenu->m.live item->item.right ~= null() then do;
next-menu = new menu->m.live item->item.right;
call kill menu list (next menu, menu ptr);
new menu->m.live item = null();
end;
end;
end;
164
I
>u>nardy>use>restore menu.pll, 02:40:14 Thursday April 28,
-------------- -----------------------------------------
restore-menu: procedure
1983
(menuptr);
%include menudcl;
%include menuitemdcl;
dec Laru
$draw menu
$drawprompt
entry (pointer, pointer),
entry (pointer, bit(l), pointer),
entry (pointer, bit(l), pointer),
current
previous
quitp
no
yes
normal
inverse
pointer,
pointer,
bit(l),
bit(l) init
bit(l) init
bit(l) init
bit(l) init
$drawtitle
/ **************************~~****
(''b),
('l'b),
(0'b),
('l'b);
**********
*********
*********
/
current = menuptr->menu_seg.root menu->m.first item;
menu ptr->menu seg.root menu->m.live item = current;
current points at the live item on a menu
at the outset current points to the root node--the one that
contains the title and points to the first level--of the menu
do this loop while (the live item points to another menu)
call draw menu
theader pointed to by the part of current which points to next men
current = the live item which is pointed to by the header which is
pointed to by the "right" part of the current live item
a case analysis here:
you have derived the next pointer, but it may be meaningless
if the live item pointed to by the header is a null item
or if the live item points to a null header
then quit the loop
end
do quitp = no while (quitp = no);
call $drawmenu (current->item.right, menu otr);
previous = current;
current = current->item.right->m.live item;
if current = null() then quitp = yes;
else if current->item.right = null() then quitp
end;
call $draw-title
(previous, inverse, menuptr);
yes;
165
2
>u>nardy>use>restore menu.pll
call $drawprompt (previous, normal, menuptr);
end;
166
1
>u>nardy>use>before dollar.pll, 02:38:19 Thursday April 28, 1983
before-dollar:
procedure (programname) returns (char(32)vary);
declare
i
max len
programname
substring
fix(15),
fix(15),
char(32)vary,
char(32)vary;
max len = length (programname);
substring = "";
do i = 1 to max len;
if substr (program name, i, 1) =
$" then do;
if i > 1 then return (substring);
else sub-string =
end;
else substring = sub-string || substr (program-name, i, 1);
end;
return
end;
(programname);
167
1
>u>nardy>use>match finder.plL, 02:46:06 Thursday April 28,
match
1983
finder: procedure
(newmenu, match_x, matchy, match-item, match-header, menuptr);
%include menudcl;
%include menu item dcl;
declare
$draw item
entry (pointer, bit(l), pointer),
Sdraw_menu
entry (pointer, pointer),
Skill_menu list
entry (pointer, pointer),
match x
match-y
itemptr
match item
match header
fix(15),
fix(15),
pointer,
pointer,
pointer,
endp
no
yes
inverse
bit(l),
bit(l) init ('O'b),
bit(l) init ('l'b),
bit(l) init ('l'b);
*********
******************
******************************
****
****/
match item = null();
itemptr =newmenu->m.first item;
do endp = no while (endp = no);
if
(item ptr->item.x
matchx) & (item ptr->item.y = match_y) then do;
match item = itemptr;
endp = yes;
end;
else do;
item ptr = item ptr->item.left;
if itemptr = null() then endp = yes;
end;
end;
if match item = null() then do;
if new menu->m.live item ~= null() then do;
call matchfinder (new_menu->m.liveitem->item.right,
match x, matchy, match-item, matchheader, menuptr);
end;
end;
else do;
/*
you have a match item,
now check for level
*/
168
2
>u>nardy>use>matchfinder.pll
if new menu->m.live item ~= null() then do;
call Skillmenulist (new-menu, menuptr);
end;
match header = new menu;
match header->m.live item = match item;
call $drawmenu (new-menu, menu_ptr);
end;
end;
169
1
>u>nardy>use>initmenu.pll,
init menu:
02:43:30 Thursday April 28, 1983
procedure (dirname, menufile, menuptr);
declare
ioa
entry options (variable),
com_error
entry options (variable),
hcs$initiate w options entry (char(168)vary, char(32)vary,
char(32)vary, bit(l), pointer, fix(31)),
dir name
char(168)vary,
menu file
char( 32)vary,
menuptr
pointer,
syscode
fix(31),
condition;
oops
syscodemanager: procedure (string);
declare string char(64)vary;
call comerror (syscode, "init menu", string);
signal oops;
end;
on oops begin;
goto exit;
end;
call hcs$initiate w options
(dir name, menu file, menu file, 'l'b, menu ptr, syscode);
if
syscode < 0 then call syscode manager ("initiating " |1 menu-file);
else call ioa ("--> menu '^a' has been initiated", menu-file);
exit:;
end;
170
APPENDIX V
Source
code
for contour package
171
>u>nardy>edge>contour.bind, 03:32:11 Thursday April 28, 1983
1
-----------------------------------------------------contour
c5
step5
summary5
review
vidicon
alignment
tablet
io util
172
I
>u>nardy>edge>rawfilestructure.inclpll, 03:32:34 Thursday April
declare
raw
1 font
2
2
2
2
2
2
2
2
pointer,
based (raw),
char(32)vary,
char(32)vary,
char(32)vary,
fix(15),
fix(15),
fix(15),
fix(15),
name
source
date
cap line
x line
base-line
serial num
chr [1:128],
char(12)vary,
3 name
fix(15),
3 index
2 vector [1:1] bit(16);
28, l
173
I
>u>nardy>edge>c5.pll, 03:39:11 Thursday April 28,
1983
c5: procedure;
%include raw file structure;
declare
(ioa, ioan)
entry options (variable),
askn
entry options (variable),
iocs~get
entry (char(l)vary),
grin$ocolor
entry (fix, fix, fix),
grinlinev
entry (fix, fix, fix, fix, bit(16), fix),
grin$rectv
entry (fix, fix, fix, fix, bit(16), fix),
hcs~appendseg entry (char(168)vary, char(32)vary, fix(31)),
hcs~initiate w_options entry (char(168)vary, char(32)vary,
char(32)vary, bit(l), pointer, fix(31)),
hcs$terminate
entry (pointer),
$vidicon
$tablet
$step5
$review
$alignment
declare
(x, y, z)
(xorg, yorg)
(xstep, ystep)
on
off
declare
instruction
opensequence
close_sequence
opencontour
closeforward
stepforward
close fwd right
stepfwd_right
rotate cc
check again
lookforedge
keeplookino
badstart
close-file
declare
planes8910
plane8
planelO
entry,
entry
entry
entry
entry
(fix(15), fix(15), fix(15)),
(fix, fix, fix, fix, fix, pointer),
(pointer),
(pointer);
fix(15),
fix(15),
fix(15),
fix(15) init
fix(15) init
fix(15),
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
init
init
init
init
init
init
init
init
init
init
init
init
fix(15)
init
bit(16) init
bit(16) init
bit(16) init
(1),
(0);
(1),
(2),
(3),
(4),
(5),
(6),
(7),
(8),
(9),
(10),
(11),
(12),
(13);
('0700'b4),
('0100'b4),
('0400'b4),
174
2
>u>nardy>edge>c5.pll
----------------------------------------------------------blue
green
white
font file
answer
yes
syscode
systemao
*******t
fix(15) init (1),
fix(15) init (2),
fix(15) init (7),
char(32)vary,
char(3)vary,
char(3)vary init ("yes"),
fix(31),
condition;
*****************************************************
check-ahead: procedure
/
(tentx, tenty, xorg, yorg, instruction);
declare
(tentx, tenty) fix(15),
(xorg, yorg)
fix(15),
instruction
fix(15);
declare
grin$read
grin$uncolor
(r,
g,
pixel
b)
entry (fix, fix, fix, fix, bit(32)),
entry (fix, fix, fix, bit(32)),
fix(15),
bit(32);
call grin$read
(tentx, tenty, tentx, tenty, pixel);
call grin$uncolor (b, g, r, pixel);
if
(r + b + g) > 383 then do; /* in: check for origin match *
if instruction = checkagain then do;
if (tentx = xorg) & (tenty = yorg) then
instruction = closefwd_right;
else instruction = stepfwd_right;
end;
else if (tentx = xorg) & (tenty = yorg) then
instruction = close forward;
else if instruction = look for edge then
instruction = bad start;
else if instruction = keeplooking then instruction
opencontour;
else instruction = check again;
end;
else do; /* out: no need to check for origin match */
if instruction = check again then instruction = stepforward;
else if instruction = lookforedge then
instruction = keep_looking;
else if instruction = keep_looking then instruction = keeplooking;
else instruction = rotate-cc;
end;
** * * * * ** * * * * ** * * * * ** * * * * ** * * * * *
175
3
>u>nardy>edge>c5.pll
on systemao begin;
end;
contour: entry;
call ioa
("^ocsfont capture program");
call askn ("name of font file (no spaces: use underbars): ", font file);
if length (font file) > 28 then font-file = substr (font-file, 1,~28);
font
file =
font file
||
".raw";
call hcsappend seg (">u>type>raw",
fontfile,
syscode);
unspec (raw) = '00090000'b4;
call hcs~initiate_w_options
(">u>type>raw", font file, font file, '1'b, raw, syscode);
call ioa ("--> font file
'^a'
appended and initiated", fontfile);
raw->font.name = fontfile;
call askn ("source of font (no spaces: use underbars): ", raw->font.source);
call askn ("today's date (no spaces: use underbars):
",
raw->font.date);
raw->font.serial num = 1;
raw->font.chr[l].index = 1;
call grin~ocolor (blue, green, white);
call grin$rectv (0, 0, 511, 511, planes8910, off);
call $alignment (raw);
call Svidicon;
call $step5 (0, 0, xstep, ystep, opensequence, raw);
do while ('l'b);
do z = 0 while (z < 1);
call $tablet (xorg, yorg, z);
if z = 2 then do;
do z = 2 while (z = 2);
call $tablet (x, y, z);
end;
call ioan
call
call
end;
else if z
do z
("-->
BEGIN NEW CHARACTER....");
grin$rectv (0, 0, 511, 511, planes8910, off);
$step5 (x, y, xstep, ystep, open-sequence, raw);
= 4 then do;
= 4 while (z = 4);
call $tablet (x, y, z);
end;
call askn
("-->
DO YOU
REALLY WANT TO QUIT?
(yes/no)
answer);
if answer = yes then do;
raw->font.serial num = raw->font.serial num goto wrapup;
end;
1;
176
4
>u>nardy>edge>c5.pll
end;
else if z = 8 then do;
do z = 8 while (z = 8);
call $tablet (x, y, z);
end;
call ioa ("END CHARACTER");
call $step5 (x, y, xstep, ystep, close sequence, raw);
call grin~linev (0, raw->font.base line, 511,
raw->font.base line, plane8, on);
call grin$linev (0, raw->font.x line, 511,
raw->font.x line, plane8, on);
call grin$linev (0, raw->font.cap line, 511,
raw->font.cap line, plane8, on);
call Svidicon;
end;
end;
do
z =
1 while
(z = 1);
call $tablet (xorg, yorg, z);
end;
do instruction = look-foredge while
((instruction ~= bad_start) & (instruction ~= opencontour));
call checkahead (xorg + 1, yorg, xorg, yorg, instruction);
xorg = xorg + 1;
if xorg > 511 then instruction = bad-start;
end;
if instruction = open contour then do;
call $step5 (xorg, yorg, xstep, ystep, instruction, raw);
x = xorg;
y = yorg;
do while (~((instruction = close forward) |
(instruction = close_fwd_right)));
call grin$rectv (x, y, x, y, planel0, on);
call check ahead
/* straight ahead */
(x + xstep, y + ystep, xorg, yorg, instruction);
if instruction = check again then do;
call checkahead 7* ahead and to the right */
(x + xstep + ystep, y + ystep - xstep,
xorg, yorg, instruction);
call $step5 (x, y, xstep, ystep, instruction, raw);
end;
else call $step5 (x, y, xstep, ystep, instruction, raw);
if instruction = close-file then goto wrapup;
end;
end;
end;
wrapup:
call $review (raw);
177
5
>u>nardy>edge>c5.pll
in directory '>u>type>raw'", font-file);
call ioa ("^rsaving '^a'
call hcs$terminate (raw);
end;
178
I
>u>nardy>edge>step5.pll,
step5: procedure
03:43:44
Thursday April 28, 1983
(x, y, xstep, ystep, code, raw);
%include raw-file structure;
declare
(x,
y)
(xstep, ystep)
code
fix(15),
fix(15),
fix (15);
declare
(ioa, iskn)
$summary5
entry options (variable),
entry (fix, fix, fix, fix, fix,
declare
counter
pos
(low x, high x)
(lowy, high-y)
(prey x, prey y)
prevclose counter
prevclose-pos
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
declare
safe limit
xtemp
vector index
vector length
fixnum
bit str
(15000),
fix(15) init
fix(15),
fix(15),
fix(15),
fix(15),
fix(15) defined fixnum;
declare
open-sequence
close sequence
open contour
close forward
step forward
close fwd right
step fwd right
rotate cc
close file
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix(15)
fix, fix);
static,
static,
static,
static,
static,
static,
static;
init
init
init
init
init
init
init
init
init
(1),
(2),
(3),
(4),
(5),
(6),
(7),
(8),
(13);
/*****************************************************************/
if code = opensequence then do;
counter = raw->font.chr[raw->font.serialnuml.index + 4;
pos = 1;
prev close counter = raw->font.chr[raw->font.serial num].index + 6;
prevclose pos = 1;
low x = 511;
179
2
>u>nardy>edge>step5.pll
high x = 0;
lowy = 511;
high_y = 0;
ena;
else if counter => safe limit then do;
call ioa ("--> contour vector is full");
substr (raw->font.vector [counter], 1, 4) =
code = closefile;
end;
else if code = opencontour then do;
'1010'b;
xstep = 0;
ystep = -1;
fixnum = x;
/* alias bit str */
raw->font.vector [counter] ~ bit str;
fixnum = y;
/* alias bit str */
raw->font.vector [counter + 1] = bitstr;
prevx = x;
prevy = y;
counter = counter + 2;
end;
else if code = close forward then do;
substr (raw->font.vector [counter], pos, 4) = '0000'b;
prevclosecounter = counter;
prevclosepos = pos;
counter = counter + 1;
pos = 1;
x = x + xstep;
y = y + ystep;
end;
else if code = closefwdright then do;
substr (raw->font.vector [counter], pos, 4) =
prevclose counter = counter;
prevclosepos = pos;
counter = counter + 1;
pos = 1;
x = x + xstep;
y = y + ystep;
xtemp = ystep;
/* rotate clockwise */
ystep = -xstep;
/* rotate-clockwise */
xstep = xtemp;
/* rotate-clockwise */
x =
x +
'0000'b;
xstep;
y = y + ystep;
end;
else if code = closesequence then do;
substr (raw->font.vector [prev close counter],
prevclosepos, 4) = '1010'b;
call $summary5 (lowx, highx, lowy, highy, counter,
counter - raw->font.chr[raw->font.serial num].index,
raw->font.serial num);
180
3
>u>nardy>edge>step5.pll
tixnum = low x;
/* alias bit str */
raw->font.vector[raw->font-chr[raw->font.serialnum].index] = bit str,
fixnum = low y;
/* alias bit str */
raw->font.vector[raw->font.chr[ra7w->font.serial num].index + 1] = bit str;
fixnum = high-x;
/* alias bit str */
raw->font.vector[raw->font.chr[raw->font.serial num].index + 2] = bit str;
fixnum = high y;
/* alias bit str */
raw->font.vector[raw->font.chr[raw->font.serial num].index + 3] = bit str;
call askn ("name of the current character: ",
raw->font.chr[raw->font.serialnum].name);
call ioa ("r");
raw->font.serial num = raw->font.serialnum + 1;
if raw->font.serial_num > 128 then do;
call ioa
("--> character table is now full (128 characters already stored)");
code = close-file;
end;
counter = counter + 1;
pos = 1;
raw->font.chr[raw->font.serial num].index
counter;
end;
else if code = rotatecc then do;
xtemp = -ystep;
ystep = xstep;
xstep = xtemp;
end;
else do;
if code = step forward then do;
x =
x +
xstep;
y = y + ystep;
end;
if code
stepfwd_right then do;
x =
x +
y = y
xtemp
ystep
xstep
x =
+
=
=
=
x +
xstep;
ystep;
ystep;
-xstep;
xtemp;
/*
/*
/*
rotate clockwise
rotate-clockwise
rotate-clockwise
*/
*/
*/
xstep;
y = y + ystep;
end;
if x < prev
suOttr
else if x =
substr
else substr
x then
(raw->font.vector [counter], pos, 2) =
prev x then
(raw->font.vector [counter], pos, 2) =
(raw->font.vector [counter], pos, 2) =
'll'b;
'O0'b;
'0l'b;
if y < prevy then
substr (raw->font.vector [counter], pos + 2, 2) =
'll'b;
181
4
>u>nardy>edge>step5.pll
else if y = prev y then
substr (raw->font.vector [counter], pos + 2, 2) = '00'b;
else substr (raw->font.vector [counter], pos + 2, 2) = 'Ol'b;
pos = poF + 4;
if pos > 16 then do;
counter = counter + 1;
pos
1;
end;
prevx
prevy
if x >
if x <
if y >
if y <
end;
end;
= x;
= y;
high x
low x
high y
low-y
then
then
then
then
high x =
low x =
high y =
low-y
/*
/*
/*
/*
incr position within string
if past end of string then...
incr counter to next string
set position = 1 in next string */
182
1
>u>nardy>edge>surmary5.pll, 03:34:13 Thursday April 28, 1983
summary5: procedure (lowx, highx, lowy, highy, index, length, serial num);
declare
ioa
grin$rectv
entry options (variable),
entry (fix, fix, fix, fix, bit(16),
declare
(low x, high x)
(low y, high-y)
index
length
serial num
ratio
plane9
on
(xextent,yextent)
xypixels
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
fix(15),
bit(16) init
fix(15) init
fix(31),
fix(31);
fix);
('0200'b4),
(1),
/*****************************************************************/
call
call
call
call
grin~rectv (low_x,
grin$rectv (high x,
grin~rectv (high x,
grin~rectv (lowx,
x extent
y_extent
xy pixels
ratio
call
call
call
call
call
call
call
call
end;
= high-x
-
low_y,
low_y,
high y,
high-y,
high_x,
high_x,
lowx,
lowx,
low_y,
high_y,
high_y,
lowy,
plane9,
plane9,
plane9,
plane9,
on);
on);
on);
on);
+ 1;
lowx
= high y -
low_y + 1;
= x extent
*
y extent;
= (xypixels)
7
length;
ioa ('summary:");
ioa ("
character number
^5i
(limit
ioa ("
now up to vector element ^5i
(limit
ioa ("
high-x = ^3i,
high_y = ^3i",
high x, highy);
ioa T"
low x = ^3i,
low-y = ^3i",
low X, low_y);
ioa("
image size = ^i bytes (1 byte/pixel)",
ioa ("
code size = ^i bytes", length);
ioa ("
compression ratio image:code =
^i:l",
128)", serial num);
15000)", index);
xy pixels);
ratio);
183
1
>u>nardy>edge>review.pll, 03:48:06 Thursday April 28,
1983
review: procedure (raw);
%include raw file structure;
declare
(ioa, ioan,
iocs$getc
math$sin
math$cos
grinslinev
grin$rectv
grin$rect
askn)
entry options (variable),
entry (char(l)),
entry (float(23)) returns (float(23)),
entry (float(23)) returns (float(23)),
entry (fix, fix, fix, fix, bit(lb), fix),
entry (fix, fix, fix, fix, bit(16), fix),
entry (fix, fix, fix, fix, bit(32));
declare
code_y
fix(15),
/* current contour code origin
code x
fix(15),
bit
x
bit(16) defined codex, /* allows acces S to */
bit
y
bit(16) defined codey, /* bit array as fix */
(prev_code x, prev code y)
/ * previous contour code origin
fix(15),
index
current element of bit array
fix(15),
*7
pos
fix(15);
position within bit string
declare
(cur x, cury)
(last_x, lasty)
fix(15),
fix(15);
declare
(flx, fly)
float(23),
(first-fix, first_fly)
float(23),
degrees
float(23),
radians
float(23),
reproscale
float(23),
1 xstep,
2 x
float(23),
2 y
float(23),
1 ystep,
2 x
float(23),
2 y
float (23);
declare
i
anykey
planes8910
plane8
plane9
planes910
off
fix(15),
char(1),
bit(16) init
bit(16) init
bit(16) init
bit(16) init
fix(15) init
/*
/*
current integer point
previous integer point
/*
current float point */
/*
current contour float origin
('0700'b4),
('0100'b4),
('0200'b4),
('0600'b4),
(0),
/*
/*
/*
/*
erase all
blue baseline
green box
white contour
*/
184
2
>u>nardy>edge>review.pll
on
/
fix(15) init
(1);
*****************************************************************/
inner workings: procedure (i);
declare
i
fix(15),
index
fix(15),
fixnum
fix(15),
bit str
bit(16) defined fixnum,
(lowx, high x, low y, highy, leftline)
fix(15);
index = raw->font.chr[i].index;
bit str = raw->font.vector
low x = fixnum;
bit str = raw->font.vector
low y = fixnum;
bit str = raw->font.vector
high x = fixnum;
bit
str
= raw->font.vector
high y= fixnum;
[index];
[index + 1];
[index + 2];
[index + 3];
call
call
call
call
call
grin$linev (low x, low y, high_x, low_y,
plane9, on);
grin~linev (high x, low y,
highx, highy, plane9, on);
gringlinev (high x, high y, low x, highy, plane9, on);
grin~linev (low x, high y, low x,
lowy, plane9, on);
grin$linev
(0, raw->font.base line, 511, raw->font.base line, plane8, on);
call grin$linev
(0, raw->font.xline,
511, raw->font.xline,
plane8, on);
call grin~linev
(0, raw->font.cap line,
511, raw->font.cap line,
planeB, on);
/* now adjust wrt baseline and left side */
low y = lowy - raw->font.base line;
high y = high y - raw->font.base line;
high x = high x - low x;
left line = low x;
low x = 0;
fixnum = low x;
raw->font.vector [index] = bit str;
fixnum = low y;
raw->font.vector [index + 1] = bit str;
fixnum = high x;
raw->font.vector [index + 2] = bit str;
fixnum = high y;
raw->font.vector [index + 3] = bit str;
185
3
>u>nardy>edge>review.pll
xstep.x =
1;
xstep.y = k);
ystep.x = 0;
ystep.y = 1;
bit x = raw->font.vector [index + 4];
/* alias for code x */
bit y = raw->font.vector [index + 5];
/* alias for code y */
*/
* now refigure starting point wrt baseline and leftline
code
x =
code
x -
left
line;
codey = code y - raw->font.base line;
raw->font.vector[index + 4] = bit x;
raw->font.vector[index + 5] = bit y;
prev_code x = codex;
prev_codey = code_y;
index
=
pos
= 1;
tlx
fly
first flx
first-fly
=
curx
cury
last x
last-y
=
=
=
=
index + 6;
code
x;
= code_y;
= flx;
= fly;
codex;
code_y;
codex;
codey;
do while (substr
(raw->font.vector
[index],
pos,
4)
if substr (raw->font.vector [index], pos, 4) =
'1010'b);
'OCO'b then do;
cur-x = first flx;
cur_y = firstfly;
call grin$linev (lastx + left line, lasty + raw->font.base line,
cur x + left-line, cur y + raw->font.base line, planes910, on);
index
=
index + 1;
pos = I;
bit x = raw->font.vector [index];
/* alias for code x *7
bit y = raw->font.vector [index + 1];
/* alias for codey */
/* refigure starting point wrt baseline and leftline */
code
x =
code x -
left
line;
code y = code y - raw->font.base line;
raw->font.vecTor[index]
= bit x;
raw->font.vector[index + 1] = bit~y;
index
=
first
flx =
index + 2;
first flx
+
((code x -
prevcode
x)
*
xstep.x);
186
4
>u>nardy>edge>review.pll
firstfly =
firstfly +
((codex -
prevcode x)
*
xstep.y);
first flx = first flx + ((code y - prevcode y) * ystep.x);
firstfly = firstfly + ((code-y - prevcodey) * ystep.y);
prevcode x = codex;
prevcode y = codey;
flx = first flx;
fly = first fly;
cur x = first flx;
cury = first-fly;
end;
else do;
if substr (raw->font.vector [index], pos, 2) =
flx =
'Ol'b then do;
flx + xstep.x;
fly = fly + xstep.y;
end;
else if substr (raw->font.vector [index], pos, 2) =
flx =
flx
-
fly = fly - xstep.y;
end;
if substr (raw->font.vector [index], pos + 2, 2) =
flx =
'll'b
'S'b then do;
flx + ystep.x;
fly = fly + ystep.y;
end;
else if substr (raw->font.vector [index], pos+2, 2) =
flx =
then do;
xstep.x;
flx
-
'll'b
then do;
ystep.x;
fly = fly - ystep.y;
end;
cur x = flx;
cur_y = fly;
call grin$linev (lastx + left line, last_y + raw->font.baseline,
curx + left-line, cur y + raw->font.base line, planes910, on);
pos = pos + 4;
if pos > 16 then do;
index
index + 1;
pos = 1;
end;
end;
last x = cur x;
last_y = cur_y;
end;
cur-x = first flx;
cur y = first fly;
call grin~linev (lastx + left line, lasty + raw->font.baseline,
curx + leftline, cur_y + raw->font.base line, planes910, on);
end; /* end of inner workings */
187
5
>u>nardy>edge>review.pll
call grin$rectv (0, 0, 511, 511, planes8910, off);
call grin~rect
(0, 0, 511, 511, '00000000'b4);
do i = 1 to raw->font.serial num;
call ioa ("rnow drawing serial num[^i] = ^a",
i, raw->font.chr[i].name);
call innerworkings (i);
call ioa ("...to continue, press any key");
call iocs$getc (any_key);
call grin$rectv (0, 0, 511, 511, planes8910, off);
end;
raw->font.capline = raw->font.capline - raw->font.baseline;
raw->font.x line = raw->font.x line - raw->font.base line;
raw->font.base line = 0;
ena;
188
1
>u>nardy>edge>vidicon.pll, 03:35:25 Thursday April 28, 1983
---------------------------------------------------------
vidicon: procedure;
/*
code taken from vidin.pll/gtest.pll
*/
declare
(ioa, ioan)
iocs~getc
grin$gwrite
entry options (variable),
entry (char(l)),
entry ( ,fix);
declare
spdl
spdO
lpr cd
lpd cd
inbuf [12]
any_key
(x, y, z)
break
bit(16) init('a002'b4), /* select digitizer card
bit(16) init('a000'b4), /* initialize all peripherals
bit(16) init('c000'b4), /*select shift/thresh modes
bit(16) init(d800'b4), /*select continuous digitizing
bit(16),
char(l),
fix(15),
condition;
on break begin;
goto exit;
end;
/* setup */
inbuf [i] = '803f'b4;
inbuf [2] = 'lfff'b4;
call grin$gwrite (inbuf, 2);
digitize */
'*
inbuf [1] = spdl;
/* select digitizer card
inbuf [2] = lpr cd; /* select no shift, no threshold
inbut [3] = lpd cd; /* select continuous digitizing
call grin$gwrite (inbuf, 3);
call ioan ("^r--> Press spacebar
call iocs$getc (any_key);
call
ioa
("");
7* clean up */
inbuf [1] = spdO;
call grin$gwrite (inbuf, 1);
exit:;
end;
to stop digitizing");
*/
*/
*/
*/
*/
*7
*/
189
1
>u>nardy>edge>alignment.pll, 03:56:20 Thursday April 28, 1983
alignment:
procedure
(raw);
%binclude raw file structure;
declare
(ioa, ioan)
askn
iocs$getc
Svidicon
$tablet
grin$rectv
grin$linev
entry options (variable),
entry options (variable),
entry (char(l)),
entry,
entry (fix, fix, fix),
entry (fix, fix, fix, fix, bit(16),
entry (fix, fix, fix, fix, bit(16),
declare
choice
(x, y, z)
prev_y
off
on
plane8
planes8910
char(l),
fix(15),
fix(15),
fix(15) init
fix(15) init
bit(16) init
bit(16) init
(0),
(1),
('0100'b4),
('0700'b4);
fix),
fix);
/* blue lines
/* erase all
*/
*/
/*****************************************************************/
getnumbers: procedure;
call ioa ('umeric values for lines currently are:
call ioa (
cap height located at ^i", raw->font.cap line);
call ioa ("
x height located at
^i",
raw->font.x line);
call ioa (
base line located at
^i",
raw->font.base line);
call grin$rectv (0, 0, 511, 511, planes8910, off);
call askn ("^r enter new location of base line (0-511):
raw->font.baseline);
call grin$linev
(0, raw->font.baseline, 511, raw->font.baseline, plane8, on);
call askn ("
enter new location of cap-height line (0-511):
raw->font.capline);
call grin~linev
(0, raw->font.capline, 511, raw->font.capline, plane8, on);
call askn (
enter new location of x-height line (0-511):
raw->font.xline);
call grin$linev
(0, raw->font.xline, 511, raw->font.xline, planeS, on);
end;
/**** *********************************
190
2
>u>nardy>edge>alignment.pll
-------------------------------------------------------
display_lines: procedure;
call
call
call
call
call
call
ioa ("isplay lines:");
ioa ("
cap height located at ^i", raw->font.cap line);
ioa ("
x height located at
^i",
raw->font.x-line);
ioa ("
base line located at
^i",
raw->font.base line);
grin$rectv (0, 0, 511, 511, planes8910, off);
grin~linev
(0, raw->font.base_line, 511, raw->font.baseline, plane8, on);
call grin$linev
(0, raw->font.xline, 511, raw->font.x line, plane8, on);
call grin~linev
(0, raw->font.cap_line, 511, raw->font.cap_line, plane8, on);
end;
/ ***********************************/
set_cap: procedure;
call ioa ("ap height via tablet:");
call ioa ("
press 1 to position cap line");
call ioa ("
press 2 to move cap line down 1 pixel");
call ioa ('
press 3 to accept position");
call ioa ("
press 4 to move cap line up 1 pixel");
prev_y = raw->font.capline;
call $tablet (z, y, z); /* flush */
do z = 0 while (z ~= 4);
do z = 0 while (z < 1);
/* await press
call $tablet (x, y, z);
end;
*/
if z = 1 then do;
do z = 1 while (z ~= 0); /* await release */
call Stablet (x, raw->font.capline, z);
call grin$linev (0, prevy, 511, prevy, plane8, off);
call grin~linev (0, raw->font.cap line, 511,
raw->font.cap_line, plane8, on);
prev_y = raw->font.cap_line;
end;
end;
else if z = 2 then do;
do z = 2 while (z = 2); /* await release */
call $tablet (x, y, z);
end;
raw->font.capline = raw->font.cap_line - 1;
call grin$linev (0, prev_y, 511, prev_y, plane8,
off);
191
3
>u>nardy>edge>alignment.pll
call grin~linev (0,
raw->font.cap line,
raw->font.capline, plane8, on);
prev_y = raw->font.capline;
end;
511,
else if z = 8 then do;
do z = 8 while (z = 8); /* await release */
call $tablet (x, y, z);
end;
raw->font.cap line = raw->font.capline + 1;
call grin$linev (0, prev y, 511, prevy, plane8, off);
call grin$linev (0, raw->font.cap line, 511,
raw->font.capline, plane8, on);
prevy = raw->font.capline;
end;
end;
call ioa ("--> cap line is located at ^i^r", raw->font.capline);
end;
/
***********************************
set x:
procedure;
call
call
call
call
call
prev
call
do z
ioa (" height via tablet:");
ioa ("
press 1 to position x line");
ioa ("
press 2 to move x line down 1 pixel");
ioa ("
press 3 to accept position");
ioa ("
press 4 to move x line up 1 pixel");
y = raw->font.x line;
Stablet (z, y, z); /* flush */
= 0 while (z ~= 4);
do z = 0 while (z < 1);
/* await press */
call $tablet (x, y, z);
end;
if z = 1 then do;
do z = 1 while (z ~= 0); /* await release */
call $tablet (x, raw->font.x line, z);
call grin~linev (0, prevy, 511, prevy, plane8, off);
call grin~linev (0, raw->font.x line, 511,
raw->font.x line, plane8, on);
prevy = raw->font.xline;
end;
end;
else if z = 2 then do;
do z = 2 while (z = 2); /* await release
call $tablet (x, y, z);
*/
192
4
>u>nardy>edge>alignment.pll
end;
raw->font.x line = raw->font.x line - 1;
call grin$lnev (0, prevy, 51f, prevy, plane8, off);
call grin$linev (0, raw->font.xline, 511,
raw->font.xline, plane8, on);
prevy = raw->font.x line;
end;
else if z = 8 then do;
do z = 8 while (z = 8); /* await release */
call Stablet (x, y, z);
end;
raw->font.x line = raw->font.x line + 1;
call grin$linev (0, prevy, 511, prevy, plane8, off);
call grin$linev (0, raw->font.xline, 511,
raw->font.x line, plane8, on);
prev_y = raw->font.x line;
end;
end;
call ioa ("--> x line is located at ^i^r", raw->font.xline);
end;
/************************************
set-base:
procedure;
call ioa ("ase height via tablet:");
call ioa ("
press 1 to position base line");
call ioa (
press 2 to move base line down 1 pixel");
call ioa (
press 3 to accept position");
call ioa ("
press 4 to move base line up 1 pixel");
prev y = raw->font.base line;
call~$tablet (z, y, z);~/* flush */
do z = 0 while (z ~= 4);
do z = 0 while (z < 1);
/* await press
call $tablet (x, y, z);
end;
if z = 1 then do;
do z = 1 while (z ~= 0); /* await release */
call $tablet (x, raw->font.base line, z);
call grin$linev (0, prevy, 511, prevy, plane8, off);
call grin$linev (0, raw->font.base line, 511,
raw->font.base line, plane8, on);
prevy = raw->font.base line;
end;
end;
else if z = 2 then do;
193
5
>u>nardy>edge>alignment.pll
do z = 2 while (z = 2); /* await release */
call $tablet (x, y, z);
end;
raw->font.base line = raw->font.base line - 1;
call grin~linev (0, prevy, 511, preyy, plane8, off);
call grin$linev (0, raw->font.base line, 511,
raw->font.base line, plane8, on);
prevy = raw->font.baseline;
end;
else if z = 8 then do;
do z = 8 while (z = 8); /* await release */
call $tablet (x, y, z);
end;
raw->font.base line = raw->font.base line + 1;
call grin~linev (0, prevy, 511, prev_y, plane8, off);
call grin$linev (0, raw->font.base line, 511,
raw->font.base line, plane8, on);
prevy = raw->font.baseline;
end;
end;
call ioa ("--> base line is located at ^i^r", raw->font-baseline);
end;
S**************************************************************
raw->font.cap line
= 400;
raw->font.x line
= 300;
raw->font.base_line = 200;
do choice = "" while
(choice
call ioa ("^rOPTIONS:");
call ioa ("
v
vidicon input
c
set cap height via tablet
x
set x height via tablet
b
set baseline via tablet
n
set cap-x-base lines numerically via keyboard
d
display cap-x-base lines on screen, values at terminal
q quit");
call ioan ("^rchoice: ");
call iocs$getc (choice);
if choice = "v" then do;
call
ioa ("idicon on");
call Svidicon;
call
ioa ("vidicon off");
end;
else if choice = "c" then call set cap;
194
6
>u>nardy>edae>alignment.pll
else
else
else
else
end;
call ioa
end;
if
if
if
if
choice
choice
choice
choice
=
=
=
=
"x"
"b"
"n"
"d"
then
then
then
then
call
call
call
call
set x;
set base;
get numbers;
displaylines;
("uit alignment procedure^r");
195
I
>u>nardy>edge>tablet.pll, 04:02:07 Thursday April 28,
tablet: procedure
(x, y, z);
declare
(x, y, z)
fix (15);
declare
grin~vis
grin$pos
Sss
$wd
Srd
entry
entry
entry
entry
entry
declare
1983
(bit(16))
(fix(15),
fix(15),
(bit(16), bit(8)),
(bit(16), bit(8)),
(bit(16), bit(8));
fix(15)),
/*
i/o ports currently invert data from/to the tablet,
so active state of bits is '0'b
next_byte
bit(8) aligned init
('OllOlllO'b), /* next_byte set
byte received
bit(8) aligned init
('10101110'b), /* byte rec'd set
resetnbbr
bit(8) aligned init
('l1101110'b), /* nb&br reset
allones
bit(S) aligned init
('llllllll'b),
allzeros
bit(8) aligned init
('00000000'b),
garbage_byte
bit(8),
first byte
bit(8),
check byte
bit(8),
raw data [1:5] bit(8), /* holds data before conversion to fix(15)
tabaddr
bit(16) init
('00aa'b4), /* address of tablet port
*
*1
*1
*
*1
*
i
wait
duration
far-field
xbits
ybits
zbits
sixteen-ones
fix(15),
fix(15),
fix(15) init
fix(15),
bit(16)
bit(16)
bit(16)
bit(16)
(45),
/*
/*
/*
/*
index for raw data [2:5] loop
index for wait loop
duration of wait loop
if > 500 cursor is in far field
defined x,
defined y,
defined z,
init
('ffff'b4);
/*****************************************************************/
call Sss (tabaddr, checkbyte);
if checkbyte = '04'b4 then do;
x = 0; y = 0; zbits = 'fe'b4;
return;
end;
do checkbyte = allones while (substr (checkbyte, 1, 1) ~= 'O'b);
do first byte = all ones while (substr (first-byte, 1, 1) ~= 'C'b);
call Swd (tab addr, next-byte);
far-field
=
0;
*
*
196
2
>u>nardy>edge>tablet.pll
do garbage_byte = allones
while (substr (garbage byte, 2, 1) ~='b);
call $rd (tabaddr, garbagebyte);
far field = far field + 1;
if far field > 500 then do;
x = 0;
y = 0;
z = -1;
return;
end;
end;
do wait = 1 to duration;
end;
call $wd (tab addr, reset nbbr);
call $rd (tab addr, first byte);
call $wd (tab addr, bytereceived);
do garbagebyte = allzeros
while (substr (garbagebyte, 2, 1) ~'lb);
call $rd (tabaddr, garbagebyte);
end;
call $wd (tabaddr, resetnbbr);
end;
raw-data [1] = firstbyte;
do i = 2 to 5;
call Swd (tabaddr, nextbyte);
do garbagebyte = allones
while (substr (garbage byte, 2, 1)
'O'b);
call $rd (tabaddr, garbagebyte);
end;
do wait = 1 to duration;
end;
call $wd (tab addr, reset nbbr);
call $rd (tab addr, raw data [i]);
call $wd (tab-addr, byte_received);
do garbagebyte =.allzeros
while (substr (garbage byte, 2, 1) ~'lb);
call $rd (tabaddr, garbagebyte);
end;
call Swd (tabaddr, resetnbbr);
end;
call $wd (tabaddr, nextbyte);
far field = 0;
do garbage byte = all ones
while (substr (garbage byte, 2, 1) ~''b);
call Srd (tab addr, garbage byte);
far field = far field + 1;
if far-field
> 500 then do;
197
3
>u>nardy>edge>tablet.pll
x
=
y
=
0;
0;
z = -1;
return;
end;
end;
do wait = 1 to duration;
end;
call Swd (tab addr, resetnbbr);
call Srd (tab addr, check byte);
call $wd (tab addr, bytereceived);
do garbage byte = allzeros
while (substr (garbagebyte, 2, 1)
call $rd (tabaddr, garbagebyte);
end;
call $wd (tab addr, reset nbbr);
'l'b);
end;
xbits = sixteen ones;
ybits = sixteen ones;
zbits = sixteen-ones;
4)
6)
6)
6)
6)
=
=
=
=
=
substr
substr
substr
substr
substr
x <
77 then
if x > 2124 then
y < 500 then
if y > 1940 then
(x 77) / 4;
(y - 500) / 3;
x
x
y
y
=
=
=
=
substr
substr
substr
substr
substr
xbits =
ybits =
zbits =
if
else
if
else
x =
y =
(zbits, 13,
(xbits, 11,
(xbits,
5,
(ybits, 11,
(ybits, 5,
~xbits;
~ybits;
~zbits;
call grin~vis
call grin~pos
end;
('0002'b4);
(2, x, y);
77;
2124;
500;
1940;
(raw data
(raw data
(raw data
(raw data
(rawdata
[1],
[2],
[3],
[4],
[5],
3,
3,
3,
3,
3,
4);
6);
6);
6);
6);
198
1
>u>nardy>tablet>tablet.doc, 03:26:29 Thursday April 28, 1983
documentation
for tablet.pil:
remote control of the tablet
parallel interface connector description:
I
2
3
4
ground
remote reset
not used
strappable
+5 volts (output)
5
6
not
not
7
in 0
8
9
10
11
12
used
used
statusvalid
out 0
in 1
out 1
in 2
out 2
rate 1
rate 2
in 3
rate 4
out 3
in 4
mode 1
out 4
in 5
mode 2
out 5
in 6
byte received
out 6
byte-available
in 7
next-byte
out 7
ground
not used
data strobe
13
14
15
16
17
18
19
20
21
22
23
24
25
Command byte:
in 7
in 6
in 5
in 4
21
19
17
15
in 3
13
in 2
11
in 1
09
in 0
07
next
byte
byte
recv
mode
2
mode
1
rate
4
rate
2
rate
1
status
valid
out 5
18
cut 4
16
out 3
14
out 2
12
out 1
10
out 0
08
Lata bytes:
out 7
22
out 6
20
byte
avail
1
0
fU
f3
->
xil ->
fl
x0
data
strobe
25
f3
f2
fl
fo
0
0
x5
x4
x3
x2
xl
xG
*
[byte 2
xll
x10
x9
x8
x7
x6
*
[byte 3
y5
y4
y3
y2
yl
yO
*
[byte
4
yll
y10
y9
y8
y7
y6
*
[byte
5
z axis value
flag
12 bit x coordinate
[byte
1
199
>u>nardy>tablet>tablet.doc
2
-------------------------------------------------------yll
->
yO
12
bit y coordinate
* data strobe is a negative or positive pulse which emulates byte available,
but which I don't think we use.
a logical
a logical
[active]
[inactive]
'l'b = switch "out" (off)
(on)
'0'b = switch "in"
The status valid bit informs the tablet that a change is desired.
status valid = 'l'b then the bit pad will read the command byte;
(status valid = 'O'b) the bit pad will search for
(front panel switch closure) I (remote command w/ active status valid);
therefore, when the host processor is changing the rate or mode setting of
the command byte it should:
first set status valid = '0'b;
then change the desired mode and/or rate setting;
finally reset statusvalid = 'l'b;
if
else
-- > But, I am given to understand that currently the P-E i/o port inverts
data from/to the tablet, so '0' is active.
The desired settings
for vlw are:
next byte:
inverted:
1
0
0
1
0
1
1
0
0
1
0
1
0
1
1
0
byte received:
inverted:
0
1
1
0
0
1
1
0
0
1
0
1
0
1
1
0
the algorithm for getting 5 bytes of information from the tablet:
(using bit values which are not inverted)
(When we arrive at the top of the loop with a 'O'b (inverted 'l'b),
we want to fall out of the loop; therefore we initialize at 'f'b
*/
so that we go thru the loop at least once. see tablet.pll
do while (firstbitofcheckbyte
~=
'0'b)
do while (first bit of first byte
(synch up to the first byte}
'l'b
set next byte <-initialize far field counter
~= '1'b)
(out)
0
do while (byte available bit = '0'b)
[wait for tablet to present data}
garbage byte <-- byte from tabletport
increment far field counter +1
<--
(in)
200
3
>u>nardy>tablet>tablet.doc
if far field counter > 500 then
(you've waited long enough. the puck
is probably not in proximity of tablet)
return
execute a delay loop to settle data
reset next byte
<--
(out)
'O'b
first byte <-- byte from tabletport
set byte received <-- 'l'b
{acknowledge data received)
do while (byte available bit = 'l'b)
{wait for tablet to-remove data}
garbage_byte <-- byte from tablet_port
reset bytereceived <-- 'O'b
raw data [1] <-- first byte
do the same for rawdata [21 to rawdata
(in)
(out)
(in)
[5]
set next byte <-- 'l'b
do while (byteavailable bit = 'O'b)
garbagebyte <-- byte from tabletport
execute delay loop to settle data
reset next byte <-- 'O'b
rawdata [i] <-- byte from tabletport
'l'b
set byte received <-do while (byteavailable bit = 'l'b)
garbage_byte <-- byte from tabletport
'O'b
reset byte-received <-(as a final check, assume the next byte is the firstbyte
of the next sequence of 5 bytes)
set
next byte <--
'l'b
initialize far field counter <-- 0
do while (byte available bit = 'O'b)
(wait for-tablet to-present data)
(in)
garbage-byte <-- byte from tabletport
increment far field-counter +1
if far field counter > 500 then
(you've waited long enough. the puck
is probably not in proximity of tablet)
return
execute delay loop to settle data
'O'b
reset nextbyte <-checkbyte <-- byte from tabletport
'l'b
set byte received <--
do while (byte available-bit = 'l'b)
garbage byte <-- byte from tabletport
reset
bytereceived
<--
'O'b