psalp@acad2.alaska.edu (01/31/91)
{This is my first posting, so here goes.
here are a couple of programs to create Nintendo type
game files. They are written in IBM turbo pascal 5.0.
Both use the text screen, but they can be rewritten to
use graphics files if wished.
player_action plots a "K" on the screen ^
and uses the <, >, and L keys to move around. 789
< 456 >
editor edits a text file using the the IBM keypad to 123
control the direction of printing V
Ctrl-Q quits and the plus and minus keys change characters.
<<<<<WARNING>>>>>
There are several bugs in the programs that I have not
had time to fix.
among them are:
No Cursor in the editor
No disk I/O routines
The Player "K" sticks at the top of the screen
No sub-screen display
Thease programs will compile and run, regardless.
If anyone fixes (or CAN fix) thease bugs, please send me a copy
via e-mail. I'm trying to update thease programs, I and will send a
new version to anyone who asks.
}
program player_action(input,output);
uses crt;
type
monstertype = record
xpos,ypos,
m1,m2,m3,m4,m5,
direction:integer;
kind:byte;
energy:integer;
end;
playertype = record
x,y,
oldx,oldy,
ph,jh,
jumpctr,
direction:integer;
jumpflag,inair:boolean;
underfoot:byte;
end;
function scan(x,y:byte):byte;
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
begin
scan :=screen[(x*2)+(160*y)];
end;
procedure place(x,y,ch:byte);
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
begin
screen[(x*2)+(160*y)] := ch;
end;
procedure scrlrt;
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
a,b:integer;
begin
for b:= 0 to 22 do
for a:= 0 to 80 do
place(a,b,scan(a+1,b));
end;
procedure scrlft;
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
a,b:integer;
begin
for b:= 0 to 22 do
for a:= 79 downto 1 do
place(a,b,scan(a-1,b));
end;
procedure writert(p:string);
begin
window(79,1,79,24);
clrscr;
write(p);
end;
procedure writelft(p:string);
begin
window(1,1,1,24);
clrscr;
write(p);
end;
procedure moveplayer(var p:playertype);
procedure jump(var ph,py:integer; jh:integer);
begin
if (ph=jh) or (py=0) then jh:=jh
else
begin
py:=py-2;
ph:=ph-1;
end;
end;
var
key:char;
begin
key:=readkey;
with p do
begin
oldx:=x;oldy:=y;
if (key='.') and (x<50) then x:=x+1;
if (key='.') and (x>48) then
begin
place(oldx,oldy,32);
scrlrt;
writert(' A A A');
end;
if (key=',') and (x>3) then x:=x-1;
if (key=',') and (x<5) then
begin
place(oldx,oldy,32);
scrlft;
writelft(' A A A A');
end;
underfoot := scan(x,y+1);
if (key='l') and (underfoot=65) and (inair=false)
then jumpctr:=7;
if jumpctr=7 then
begin
inair:=true;
jh:=y-7;
end;
if (jumpctr>0) and (y>0) then
begin
y:=y-1;
jumpctr:=jumpctr-1;
end;
if jumpctr=0 then inair:=false;
if (underfoot<>65) and (jumpctr=0) then y:=y+1;
{gotoxy(oldx,oldy);}
place(oldx,oldy,32); {write(' ');}
place(x,y,75); {gotoxy(x,y);}
{write('K');}
end;
end;
{***********************************************************************************
main program
************************************************************************************}
var p:playertype;
begin
clrscr;
textbackground(blue);
textcolor(white);
clrscr;
gotoxy(1,20);
write('AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA');
gotoxy(15,15);
write('AAAAAAAAAAAAAAAAAAAAAAAAAAAA');
p.x:=11;p.y:=11;p.jh:=10;p.jumpctr:=0;
p.inair:=false;
while red<>0 do
moveplayer(p);
end.
{This program edits the file that player_action uses.
Unfortunately thease two programs do not save or recall their files.
(This was a RUSHED first posting)
The necessary file is "linefile". }
program editor(input,output);
uses crt,printer;
type
linetype=string[22];
linearray=array[1..800] of linetype;
linefile=file of linearray;
var
key:char;
curline:string[22];
lines: linearray;
whichline:integer;
function scan(x,y:byte):byte;
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
begin
scan :=screen[(x*2)+(160*y)];
end;
procedure colorplace(x,y,ch:byte);
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
begin
screen[((x*2)-1)+(160*y)] := ch;
end;
procedure place(x,y,ch:byte);
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
begin
screen[(x*2)+(160*y)] := ch;
end;
function readcol(x:byte):string;
var
col:string[22];
y,a:integer;
begin
col:='';
for y:=0 to 21 do
begin
a:=scan(x,y);
col:=col+chr(a);
end;
readcol:=col;
end;
procedure writert(p:string);
begin
window(79,1,79,24);
clrscr;
write(p);
end;
procedure writelft(p:string);
begin
window(1,1,1,24);
clrscr;
write(p);
end;
procedure scrlrt;
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
a,b:integer;
begin
for b:= 0 to 22 do
for a:= 0 to 79 do
place(a,b,scan(a+1,b));
end;
procedure scrlft;
type
image = array[0..4000] of byte;
var
screen: image absolute $B800:0000;
a,b:integer;
begin
for b:= 0 to 22 do
for a:= 79 downto 1 do
place(a,b,scan(a-1,b));
end;
var
x,y,ox,oy,
ch,ct:integer;
begin
textbackground(cyan);
textcolor(red);
clrscr;
key:='a';x:=10;y:=10;
ch:=14;whichline:=1;
for ct:=1 to 800 do
lines[ct]:=' A A';
while key<>^Q do
begin
ox:=x;oy:=y;
key:=readkey;
case key of
'4' : if x>1 then x:=x-1;
'6' : if x<79 then x:=x+1;
'8' : if y>2 then y:=y-1;
'2' : if y<19 then y:=y+1;
'-' : if ch>0 then ch:=ch-1;
'+' : if ch<255 then ch:=ch+1;
'e' : {end};
end;
if (key='6') and (x=79) and (whichline<799) then
begin
lines[whichline]:=readcol(2);
scrlrt;
writert(lines[whichline+79]);
whichline:=whichline+1;
end;
if (key='4') and (x=1) and (whichline>1) then
begin
lines[whichline+79]:=readcol(79);
scrlft;
writelft(lines[whichline]);
whichline:=whichline-1;
end;
colorplace(x,y,red+16*cyan);
place(x,y,ch);
colorplace(ox,oy,red+16*cyan);
place(ox,oy,ch);
lines[whichline+x,y]:=chr(ch);
end;
end.
{
+---------------------------------------------------------------+
| Ambidextrous- Can use Apples and IBMs |
| |
| -Perry |
+---------------------------------------------------------------+
}