eldorado@ECN.PURDUE.EDU (David D Jansen) (11/06/90)
Keywords: turtlegraphics, DHR
Attached is a UCSD Apple Pascal unit for drawing Double High Resolution
drawings. This is Public Domain and its first release. It can replace
the standard Turtlegraphics unit by adjusting procedure call names and
some x-coordinates. It does have some conflicts with a few other
procedures, like readln, and page (output). In the case of the readln,
first "poke (main,0)" and then follow that with your readln statement. In
the case of the page (output), it turns off some softswitch so you must
call dhrgrafmode (similar to grafmode). This will create a color screen
(140 x 192) and also black & white (560 x 192). Even if you don't program
in USCD Pascal, these routines are valid so if they are translated to C,
BASIC or better yet, assembly this code is can be your guideline. BTW,
these routines are SLOW and some lines are not continuous at certain
angles. Send any comments, suggestions or flames to me. Enjoy.
(*$S+*)
UNIT DHRGRAPHICS;
INTERFACE
USES (*$U #4:SYSTEM.LIBRARY*) TRANSCEND, TURTLEGRAPHICS;
const
IOUdis = -16258; {the softswitch to turn off the IOU}
DHR = -16290; {the softswitch to toggle the double hires screen}
hires = -16297; {the softswitch to toggle hires graphics}
aux = -16299; {the softswitch to access auxillary memory}
main = -16300; {the softswitch to access main memory}
fullscrn = -16302; {the softswitch to toggle a full graphics screen}
textdis = -16303; {the softswitch to return to a text screen}
graphics = -16304; {the softswitch to toggle the graphics mode}
col80 = -16371; {the softswitch to toggle an 80 column screen}
store80 = -16383; {the softswitch to switch between main and aux memory}
page2sw = -16356; {the status determining which screen is displayed}
xhi = 3449; {the most significant byte in the x coordinate}
xlo = 3450; {the least significant byte in the y coordinate}
ylo = 3452; {the turtlegraphics y coordinate}
color = 3453; {the color which is currently being plotted}
mode = 3454; {the mode currently being used: b&w or color}
base = 8192; {the base of the page 1 hires screen}
pi = 3.14159;
type
hues = (blak,darkblue,darkgreen,mediumblue,brown,grey2,grene,aqua,magenta,
purple,grey1,lightblue,orang,pink,yellow,wite,nun);
modes = (bw,clr);
screen = packed array [1..560,1..192] of boolean;
byte = 0..255;
memloc = packed array [0..1] of byte;
access = record
case boolean of
true: (address:integer);
false: (pointer: ^memloc);
end;
var
prntr:text;
function peek (addrs:integer):byte;
procedure poke (addrs:integer;val:byte);
procedure dhrsetmode (style:modes);
procedure dhrgrafmode;
procedure dhrinitturtle;
procedure dhrscreen (bitmap:screen);
function dhrscrnxy (i,j:integer):integer;
procedure dhrcprinter;
procedure dhrprinter;
procedure dhrcplot (x,y:integer);
procedure dhrplot (x,y:integer);
procedure dhrmove (z:integer);
procedure dhrmoveto (x,y:integer);
procedure dhrpencolor (clr:hues);
procedure dhrturn (theta:integer);
procedure dhrturnto (theta:integer);
procedure dhrtextmode;
procedure showturtle;
IMPLEMENTATION
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To return a value between 0 and 255 from any given memory }
{ location. }
{ }
{ Input: addrs - The numerical address of the memory location. }
{ }
{ Output: A value of 0 to 255 which was copied from the memory location. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
function peek;
var
memory:access;
begin
memory.address:=addrs;
peek:=memory.pointer^[0];
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To store a value of 0 to 255 from a variable into a memory }
{ location. }
{ }
{ Input: addrs - The integer memory address where to store a value. }
{ val - The value to store in the memory location. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure poke;
var
memory:access;
begin
memory.address:=addrs;
memory.pointer^[0]:=val;
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To set the color mode for drawing: The options are black and }
{ white and color. The resolution changes depending on which mode }
{ is chosen. In the black and white mode the screen is 560x192 }
{ pixels. In the color mode the screen is 140x192 pixels but also }
{ includes 16 colors. }
{ }
{ Input: style - the mode chosen, specifically b&w or color. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrsetmode;
begin
if (style = bw) then
poke (mode,0)
else
poke (mode,1);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To set up the DHR graphics screen with out clearing it or setting }
{ the color or drawing mode; similar to grafmode. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrgrafmode;
begin
poke (fullscrn,0); {full screen}
poke (hires,0); {hires on}
poke (col80,0); {80 col on}
poke (graphics,0); {graphics on}
poke (IOUdis,0); {IOUdis on}
poke (DHR,0); {DHR on}
poke (store80,0); {80 store on}
poke (main,0); {main}
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To initialize and clear the DHR screen; similar to initturtle. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrinitturtle;
begin
dhrgrafmode; {set DHR graphics mode}
initturtle; {clear main graphics screen; poke 230,20: call 62450}
poke (aux,0); {aux}
initturtle; {clear aux graphics screen; poke 230,20: call 62450}
poke (main,0); {main}
poke (color,16); {set color to none}
poke (mode,0); {set mode to black and white}
poke (ylo,95); {set initial coordinates}
poke (xhi,1);
poke (xlo,23);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To copy a two dimentional array of boolean to the screen. }
{ The following definition must be made globally: }
{ type screen = packed array [1..560,1..192] of boolean; }
{ }
{ Input: bitmap - the two dimentional array to be placed on the DHR screen. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrscreen;
var
a,b,c,d,i,j,p,r,s,t,x,y:integer;
begin
dhrgrafmode;
for y:=0 to 191 do
begin
c:=y div 64; {calculate which row of bytes the bit is on}
d:=y mod 64;
b:=d div 8;
a:=d mod 8;
j:=(1024 * a) + (128 * b) + (40 * c) + base;
for i:=0 to 79 do
begin
if ((i mod 2) = 0) then {sets the correct screen}
poke (aux,0)
else
poke (main,0);
p:=64; {initialize variables}
r:=0;
s:=(7 * i) + 1;
t:=y + 1;
for x:=0 to 6 do {sets the current byte according to the array bitmap}
begin
if bitmap[s + x,t] then
r:=r + p;
p:=p div 2;
end;
poke ((i div 2) + j,r); {store current byte and repeat}
end;
end;
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To return the color of a pixel; only valid data is returned in }
{ the color mode. }
{ }
{ Input: i - The DHR x coordinate }
{ j - The DHR y coordinate }
{ }
{ Output: The color of the pixel at coodinates (i,j) represented by a number }
{ 0 through 16. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
function dhrscrnxy;
var
pix,nibble,lsb,msb,bytelo,bytehi,a,b,c,d,e:integer;
page:boolean;
begin
nibble:=i div 4; {find nibble endpoints of coordinate (x,y)}
lsb:=nibble * 4;
msb:=lsb + 3;
c:=j div 64; {calculates which row the nibble is on}
d:=j mod 64;
b:=d div 8;
a:=d mod 8;
e:=(1024 * a) + (128 * b) + (40 * c) + base;
bytelo:=lsb div 14 + e; {gets bytes that the nibble may be in}
bytehi:=msb div 14 + e;
page:=(lsb div 7) mod 2 = 1; {gets status of the page2 softswitch}
if page then
poke (main,0) {main}
else
poke (aux,0); {aux}
case ((lsb mod 28) div 4) of {masks out bits to get color from byte(s)}
0: dhrscrnxy:=ord (odd (peek (bytelo)) and odd (15));
1: begin
pix:=ord (odd (peek (bytelo)) and odd (112)) div 16;
if page then
poke (aux,0)
else
poke (main,0);
dhrscrnxy:=ord (odd (peek (bytehi)) and odd (1)) * 8 + pix;
end;
2: dhrscrnxy:=ord (odd (peek (bytelo)) and odd (30)) div 2;
3: begin
pix:=ord (odd (peek (bytelo)) and odd (96)) div 32;
if page then
poke (aux,0)
else
poke (main,0);
dhrscrnxy:=ord (odd (peek (bytehi)) and odd (3)) * 4 + pix;
end;
4: dhrscrnxy:=ord (odd (peek (bytelo)) and odd (60)) div 4;
5: begin
pix:=ord (odd (peek (bytelo)) and odd (64)) div 64;
if page then
poke (aux,0)
else
poke (main,0);
dhrscrnxy:=ord (odd (peek (bytehi)) and odd (7)) * 2 + pix;
end;
6: dhrscrnxy:=ord (odd (peek (bytelo)) and odd (120)) div 8;
end;
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: A color screen dump for an Apple Scribe printer of the DHR }
{ screen. This routine may work for the popular Imagewriter line }
{ of printers. /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ }
{ Purpose: To convert a color nibble to a data pattern emulating a color }
{ on the printer. }
{ }
{ Input: clr - The color to be converted into a printer color pattern. }
{ }
{ Output: y1,y2,y3,y4 - The yellow component of the color }
{ r1,r2,r3,r4 - The red component of the color }
{ b1,b2,b3,b4 - The blue component of the color }
{ }
{ The patterns for each color are in this form: }
{ }
{ column y(ellow) r(ed) b(lue) }
{ +---+---+---+---+ +---+---+---+---+ +---+---+---+---+ }
{ 0| | | | | | | | | | | | | | | }
{ 1| | | | | | | | | | | | | | | }
{ 2| | | | | | | | | | | | | | | }
{ 3| | | | | | | | | | | | | | | }
{ +---+---+---+---+ +---+---+---+---+ +---+---+---+---+ }
{ y1 y2 y3 y4 r1 r2 r3 r4 b1 b2 b3 b4 }
{ }
{ Each column can represent a number from 0 to 15. This is because }
{ each column is a nibble and each row a bit in the nibble. The }
{ most significant bit is in row 4. This infomation is given so }
{ it may be easily customized. It is already set up and need not be }
{ changed. Some patterns were copied from the program Dazzle Draw. }
{ }
{ y1, y2, y3, y4, etc. can be calculated and substituted in the }
{ following procedure. For example, a double yellow line is to be }
{ printed. y1, y2, y3, y4 are equal to 2 to the column where the }
{ printed material is. In this case y1, y2, y3, y4 are equal to 5 }
{ 10, depending on what you prefer. }
{ }
{ column y(ellow) xolumn y(ellow) }
{ +---+---+---+---+ +---+---+---+---+ }
{ 0| X | X | X | X | 0| | | | | }
{ 1| | | | | 1| X | X | X | X | }
{ 2| X | X | X | X | 2| | | | | }
{ 3| | | | | 3| X | X | X | X | }
{ +---+---+---+---+ +---+---+---+---+ }
{ y1 y2 y3 y4 = 5 y1 y2 y3 y4 = 10 }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure clrtodata (clr:integer;var y1,y2,y3,y4,r1,r2,r3,r4,
b1,b2,b3,b4:integer);
begin
y1:=0; y2:=0; y3:=0; y4:=0; {initialize to white}
r1:=0; r2:=0; r3:=0; r4:=0;
b1:=0; b2:=0; b3:=0; b4:=0;
case clr of
0: begin
y1:=15; y2:=15; y3:=15; y4:=15; {black}
r1:=15; r2:=15; r3:=15; r4:=15;
b1:=15; b2:=15; b3:=15; b4:=15;
end;
1: begin
b1:=15; b2:=15; b3:=15; b4:=15; {dark blue}
end;
2: begin
y1:=15; y2:=15; y3:=15; y4:=15; {dark green}
b1:=15; b2:=15; b3:=15; b4:=15;
end;
3: begin
b1:=3; b2:=3; b3:=12; b4:=12; {medium blue}
end;
4: begin
y1:=15; y2:=5; y3:=15; y4:=10; {brown}
r1:=10; r2:=10; r3:=5; r4:=5;
b1:=10; b2:=5; b3:=5; b4:=10;
end;
5: begin
y1:=3; y2:=3; y3:=12; y4:=12; {grey pattern 2}
r1:=3; r2:=3; r3:=12; r4:=12;
b1:=3; b2:=3; b3:=12; b4:=12;
end;
6: begin
y1:=15; y2:=15; y3:=15; y4:=15; {green}
b1:=1; b2:=4; b3:=1; b4:=4;
end;
7: begin
y1:=1; y2:=4; y3:=1; y4:=4; {aqua}
b1:=15; b2:=15; b3:=15; b4:=15;
end;
8: begin
r1:=15; r2:=15; r3:=15; r4:=15; {magenta}
end;
9: begin
r1:=15; r2:=15; r3:=15; r4:=15; {purple}
b1:=15; b2:=15; b3:=15; b4:=15;
end;
10: begin
y1:=1; y2:=4; y3:=1; y4:=4; {gray pattern 1}
r1:=1; r2:=4; r3:=1; r4:=4;
b1:=1; b2:=4; b3:=1; b4:=4;
end;
11: begin
b1:=1; b2:=4; b3:=1; b4:=4; {light blue}
end;
12: begin
y1:=15; y2:=15; y3:=15; y4:=15; {orange}
r1:=15; r2:=15; r3:=15; r4:=15;
end;
13: begin
r1:=1; r2:=4; r3:=1; r4:=4; {pink}
end;
14: begin
y1:=15; y2:=15; y3:=15; y4:=15; {yellow}
end;
15: ; {white}
end;
end;
begin {dhrcprinter}
rewrite (prntr,'PRINTER:');
for j:=0 to 31 do {number of rows}
begin
dhrgrafmode;
n:=6 * j;
for i:=0 to 139 do {number of columns}
begin
m:=4 * i;
for k:=0 to 5 do {load array with color components}
begin
clr:=dhrscrnxy (m,n + k);
clrtodata (clr,yel[m,k],yel[m+1,k],yel[m+2,k],yel[m+3,k],
red[m,k],red[m+1,k],red[m+2,k],red[m+3,k],
blu[m,k],blu[m+1,k],blu[m+2,k],blu[m+3,k]);
end;
end;
writeln (prntr); {print yellow}
write (prntr,chr(27),'K1');
write (prntr,chr(27),'j');
write (prntr,chr(27),'C1120');
for k:=0 to 559 do
begin
pixel1:=yel[k,0] + yel[k,1]*16;
pixel2:=yel[k,2] + yel[k,3]*16;
pixel3:=yel[k,4] + yel[k,5]*16;
write (prntr,chr(pixel1),chr(pixel2),chr(pixel3));
write (prntr,chr(pixel1),chr(pixel2),chr(pixel3));
end;
writeln (prntr); {print red}
write (prntr,chr(27),chr(114));
writeln (prntr);
write (prntr,chr(27),chr(102));
write (prntr,chr(27),'K2');
write (prntr,chr(27),'j');
write (prntr,chr(27),'C1120');
for k:=0 to 559 do
begin
pixel1:=red[k,0] + red[k,1]*16;
pixel2:=red[k,2] + red[k,3]*16;
pixel3:=red[k,4] + red[k,5]*16;
write (prntr,chr(pixel1),chr(pixel2),chr(pixel3));
write (prntr,chr(pixel1),chr(pixel2),chr(pixel3));
end;
writeln (prntr); {print blue}
write (prntr,chr(27),chr(114));
writeln (prntr);
write (prntr,chr(27),chr(102));
write (prntr,chr(27),'K3');
write (prntr,chr(27),'j');
write (prntr,chr(27),'C1120');
for k:=0 to 559 do
begin
pixel1:=blu[k,0] + blu[k,1]*16;
pixel2:=blu[k,2] + blu[k,3]*16;
pixel3:=blu[k,4] + blu[k,5]*16;
write (prntr,chr(pixel1),chr(pixel2),chr(pixel3));
write (prntr,chr(pixel1),chr(pixel2),chr(pixel3));
end;
end;
close (prntr);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: A black and white DHR screen dump for the Apple Scribe. This }
{ printer driver may work with an Apple Imagewriter. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrprinter;
var
a,b,c,d,i,k,t,v,w,x,y,pix1,pix2,pix3:integer;
bit,j:array [0..5] of integer;
begin
dhrgrafmode; {initialize graphics screen and printer}
rewrite (prntr,'PRINTER:');
writeln (prntr);
for w:=0 to 31 do {number of rows}
begin
k:=6 * w;
for i:=k to k+5 do {find row of bytes for 6 consecutive vertical points}
begin
c:=i div 64;
d:=i mod 64;
b:=d div 8;
a:=d mod 8;
j[i]:=(1024 * a) + (128 * b) + (40 * c) + base;
end;
write (prntr,chr(27),'j'); {printer graphics mode}
write (prntr,chr(27),'C1120');
for v:=0 to 79 do {number of columns}
begin
if ((v mod 2) = 0) then {set the correct screen}
poke (aux,0) {page2 on}
else
poke (main,0); {page2 off}
for y:=k to (k + 5) do {get status of 6 points}
bit[y - k]:=peek ((v div 2) + j[y - k]);
t:=64;
for x:=((7 * v) + 6) downto (7 * v) do {print 7 bits of the byte}
begin
if odd (bit[0]) and odd (t) then
pix1:=15
else
pix1:=0;
if odd (bit[1]) and odd (t) then
pix1:=240+pix1;
if odd (bit[2]) and odd (t) then
pix2:=15
else
pix2:=0;
if odd (bit[3]) and odd (t) then
pix2:=240+pix2;
if odd (bit[4]) and odd (t) then
pix3:=15
else
pix3:=0;
if odd (bit[5]) and odd (t) then
pix3:=240+pix3;
write (prntr,chr(pix1),chr(pix2),chr(pix3)); {send to printer}
write (prntr,chr(pix1),chr(pix2),chr(pix3));
t:=t div 2;
end;
end;
writeln (prntr); {new line}
end;
close (prntr);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To plot a color pixel at a given coordinate. }
{ }
{ Input: x - The DHR x coordinate }
{ y - The DHR y coordinate }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrcplot;
var
clr,nibble,msb,lsb,bytelo,bytehi,a,b,c,d,j:integer;
page:boolean;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ }
{ b - A constant by which to divide. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure setpixel (pixel,mask,a,b:integer);
var
clrs,pix:integer;
begin
clrs:=clr * a div b; {shift color left or right}
pix:=peek (pixel);
pix:=ord (odd (pix) and odd (mask)); {mask with color}
pix:=ord (odd (pix) or odd (clrs)); {set color}
poke (pixel,pix mod 256);
end;
begin {dhrcplot}
clr:=peek (color);
if (clr <> 16) then {ignore procedure if color is none}
begin
nibble:=x div 4; {get endpoints of color nibble}
lsb:=nibble * 4;
msb:=lsb + 3;
y:=191 - y;
c:=y div 64; {calculate row of screen from y coordinate}
d:=y mod 64;
b:=d div 8;
a:=d mod 8;
j:=(1024 * a) + (128 * b) + (40 * c) + base;
bytelo:=lsb div 14 + j; {get possible bytes which contain color nibble}
bytehi:=msb div 14 + j;
page:=((lsb div 7) mod 2) = 1; {get page2 softswitch status}
if page then
poke (main,0)
else
poke (aux,0);
case ((lsb mod 28) div 4) of {mask bytes and store color}
0: setpixel (bytelo,112,1,1);
1: begin
setpixel (bytelo,15,16,1);
if page then
poke (aux,0)
else
poke (main,0);
setpixel (bytehi,126,1,8);
end;
2: setpixel (bytelo,97,2,1);
3: begin
setpixel (bytelo,31,32,1);
if page then
poke (aux,0)
else
poke (main,0);
setpixel (bytehi,124,1,4);
end;
4: setpixel (bytelo,67,4,1);
5: begin
setpixel (bytelo,63,64,1);
if page then
poke (aux,0)
else
poke (main,0);
setpixel (bytehi,120,1,2);
end;
6: setpixel (bytelo,7,8,1);
end;
end;
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To plot a white or black dot on the DHR screen. }
{ }
{ Input: x - The DHR x coordinate }
{ y - The DHR y coordinate }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrplot;
var
bit,clr,a,b,c,d,h,i,j,k,l:integer;
begin
y:=191 - y;
c:=y div 64; {calculate byte of point (x,y)}
d:=y mod 64;
b:=d div 8;
a:=d mod 8;
i:=x div 7;
h:=x mod 7;
j:=(1024 * a) + (128 * b) + (40 * c) + base + (i div 2);
l:=1; {mask to set correct bit}
for k:=1 to h do
l:=l*2;
if ((i mod 2) = 1) then {set screen}
poke (main,0)
else
poke (aux,0);
bit:=peek (j);
clr:=peek (color);
if (clr=15) then
bit:=ord (odd (bit) or odd (l)) {plot white point}
else
if (clr=0) then
bit:=ord (odd (bit) and not (odd (l))); {plot black point}
poke (j,bit);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To move a given distance, usually while drawing a line of some }
{ color. The direction moved depends upon the angle previously }
{ set by the routines dhrmoveto(), dhrturn(), or dhrturnto(). }
{ Similar to move(). }
{ }
{ Input: z - The distance to move or the length of the line desired drawn. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrmove;
var
ang,phi:real;
theta,i,j,k,x,y:integer;
style:boolean;
begin
style:=(peek (mode) = 0); {get current parameters}
i:=256 * peek (xhi) + peek (xlo);
j:=peek (ylo);
theta:=turtle_angle;
if (theta <= 90) or (theta > 270) then {set increment}
k:=1
else
k:=-1;
phi:=theta * pi / 180.0;
if (theta = 90) or (theta = 270) then
begin
z:=round (z * sin (phi) + j + k); {draw a vertical line}
j:=j + k;
while (j <> z) do
begin
if style then {plot a black & white or a color point}
dhrplot (i,j)
else
dhrcplot (i,j);
j:=j + k;
end;
j:=j - k;
end
else
begin
x:=i; {draw a line other than a vertical line}
y:=j;
ang:=sin (phi) / cos (phi);
z:=round (z * cos (phi) + i + k);
i:=i + k;
while (i <> z) do
begin
j:=round (ang * (i-x) + y);
if style then {plot a black & white or a color point}
dhrplot (i,j)
else
dhrcplot (i,j);
i:=i + k;
end;
i:=i - k;
end;
poke (xlo,i mod 256); {store new coordinates}
poke (xhi,i div 256);
poke (ylo,j);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To move to a given DHR coordinate usually to draw a line. This }
{ routine is similar to moveto (). }
{ }
{ Input: x - The DHR x coordinate to which to move. }
{ y - The DHR y coordinate to which to move. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrmoveto;
var
ang:real;
i,j,k,p,q:integer;
style:boolean;
begin
style:=(peek (mode) = 0); {get current parameters}
i:=256 * peek (xhi) + peek (xlo);
j:=peek (ylo);
if (x > i) or ((x = i) and (y > j)) then {set increment}
k:=1
else
k:=-1;
if (i = x) then
begin
j:=j + k; {vertical line}
while (j <> (y+k)) do
begin
if style then {plot a black & white or a color point}
dhrplot (i,j)
else
dhrcplot (i,j);
j:=j + k;
end;
j:=j - k;
end
else
begin
p:=i; {draw a line other than a vertical line}
q:=j;
ang:=(y - j) / (x - i);
i:=i + k;
while (i <> (x+k)) do
begin
j:=round (ang * (i-p) + q);
if style then {plot a black & white or a color point}
dhrplot (i,j)
else
dhrcplot (i,j);
i:=i + k;
end;
i:=i - k;
end;
poke (xlo,i mod 256); {store new coordinates}
poke (xhi,i div 256);
poke (ylo,j);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To set the color of the next pixel(s) plotted. This routine sets }
{ the color for both color and black and white modes and is similar }
{ to the routine pencolor(). }
{ }
{ Input: clr - The color or abbreviation of the color which is desired to }
{ be plotted. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrpencolor;
begin
case clr of
blak : poke (color,0);
darkblue : poke (color,1);
darkgreen : poke (color,2);
mediumblue : poke (color,3);
brown : poke (color,4);
grey2 : poke (color,5);
grene : poke (color,6);
aqua : poke (color,7);
magenta : poke (color,8);
purple : poke (color,9);
grey1 : poke (color,10);
lightblue : poke (color,11);
orang : poke (color,12);
pink : poke (color,13);
yellow : poke (color,14);
wite : poke (color,15);
nun : poke (color,16);
end;
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To turn by a given angle relative to the present angle. The }
{ same as turn(). }
{ }
{ Input: theta - The value in degrees by which to turn. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrturn;
var
phi:integer;
alpha:real;
begin
theta:=theta mod 360;
phi:=theta;
if (phi>270) then
phi:=phi-360
else
if (phi>90) then
phi:=180-phi;
alpha:=phi / 90;
phi:=round (atan (alpha / (1 + sqr (abs (1 - alpha*alpha)))) * 360 / pi);
if (theta>270) then
phi:=360+phi
else
if (theta>180) then
phi:=180-phi
else
if (theta>90) then
phi:=180-phi;
turn (phi);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To turn to a given angle where 0 degrees is 3 O'clock, 90 degrees }
{ is 12 O'clock, etc. Exactly the same as turnto (). }
{ Input: theta - The angle in degrees to which to turn. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrturnto;
var
phi:integer;
alpha:real;
begin
theta:=theta mod 360;
phi:=theta;
if (phi>270) then
phi:=phi-360
else
if (phi>90) then
phi:=180-phi;
alpha:=phi / 90;
phi:=round (atan (alpha / (1 + sqr (abs (1 - alpha*alpha)))) * 360 / pi);
if (theta>270) then
phi:=360+phi
else
if (theta>180) then
phi:=180-phi
else
if (theta>90) then
phi:=180-phi;
turnto (phi);
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To clear the graphics mode and set up the 80 column text screen. }
{ This routine does not clear the text screen; it is similar to }
{ textmode. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure dhrtextmode;
begin
poke (store80 - 1,0); {turn off 80 store softswitch}
poke (DHR + 1,0); {turn off the double hi resolution softswitch}
poke (main,0); {turn on text page 1}
poke (textdis,0); {turn on the text screen}
end;
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{ Purpose: To draw a white arrow at the location and angle of the turtle. }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
procedure showturtle;
var
x,y,angle,clr,style:integer;
begin
x:=256 * peek (xhi) + peek (xlo); {save current parameters}
y:=peek (ylo);
angle:=turtle_angle;
clr:=peek (color);
style:=peek (mode);
dhrsetmode (bw);
dhrpencolor (wite); {draw arrow}
dhrturn (135);
dhrmove (5);
dhrturn (135);
dhrmove (7);
dhrmoveto (x,y); {restore previous parameters}
dhrturnto (angle);
poke (color,clr);
poke (mode,style);
end;
begin
end.
Just back for a visit.
_______________________________________________________________________________
Dave Jansen | INTERNET: eldorado@en.ecn.purdue.edu
Electrical Engineering | BITNET: eldorado%ea.ecn.purdue.edu@purccvm
Purdue University | UUCP: {purdue, pur-ee}!en.ecn.purdue.edu!eldorado