| MUSIK | CHAT | SPECIAL | LINKS |
| HOME | NEWS | AWARDS | ABOUT ME | TEXTE | REFERATE | PROJEKTE |
| MUSIK
| CHAT
| SPECIAL | LINKS |
6. Listing
program regma;
uses crt,maus;
type
tOperation = (LDA,LDK,STA,ADD,SUB,MUL,DIW,JMP,JEZ,JNE,JLZ,JLE,JGZ,JGE,INP,
OUT,HLT);
tAdresse = byte;
tBefehl = record
operation : tOperation;
adresse : tAdresse;
end;
tDatum =-255..255 ;
tProgrammspeicher = array[1..255] of tBefehl;
tDatenspeicher = array[0..255] of tDatum;
tBefehlswoerter = array[1..17] of string[3];
tfenster = 1..6;
tframe = record
framet: string[19];
x, y, l, h, c1, c2, sy, my : Byte;
end;
eframes = (HOTKEYS,MONITOR,PROZESSOR,HILFE,PROGSPEICHER,DATSPEICHER,SCREEN);
const
befehlswort : array[tOperation] of string[3] = ('LDA','LDK','STA','ADD','SUB','MUL',
'DIW','JMP','JEZ','JNE','JLZ','JLE',
'JGZ','JGE','INP','OUT','HLT');
cframes : array[eFrames] of tframe
= ((framet: ' Hotkeys ';
x:01; y:01; l:17; h:07; c1:11; c2:01; sy:00; my: 00),
(framet: ' Monitor ';
x:62; y:01; l:17; h:07; c1:11; c2:01; sy:00; my: 00),
(framet: ' Prozessor ';
x:20; y:03; l:40; h:11; c1:14; c2:02; sy:00; my: 00),
(framet: ' Hilfe\Information ';
x:20; y:17; l:40; h:07; c1:11; c2:01; sy:00; my: 00),
(framet: ' Programmsp. ';
x:02; y:11; l:16; h:13; c1:14; c2:02; sy:00; my: 13),
(framet: ' Datensp. ';
x:62; y:11; l:16; h:13; c1:14; c2:02; sy:00; my: 13),
(framet: '';
x:1; y:1; l:80; h:25; c1:14; c2:02; sy:00; my: 13));
var
progMem :tProgrammspeicher;
dataMem :tDatenSpeicher;
ax :tDatum;
ip :tAdresse;
l :integer;
monitorSpalte :word;
fileName :string;
helpfile :file of string;
const bkgcolor:byte=blue;
link :byte=red;
helpok :boolean=true;
procedure setWindow(what:eFrames);
begin
window(cFrames[what].x+1,cFrames[what].y+1,
cFrames[what].l+cFrames[what].x-1,
cFrames[what].h+cFrames[what].y);
textcolor(cFrames[what].c1);
textbackground(cFrames[what].c2);
gotoxy(1,1);
end;
procedure printtext(s:string;maxx:byte);
var i :byte;
wort:string;
zeilezeichen:byte;
procedure getword(var w:string;beg:byte);
var j :byte;
begin
j:=beg;
w:='';
while (s[j]<>' ') and (j<=length(s)) do begin
w:=w+s[j];
inc(j);
end;
end;
begin
i:=1;
zeilezeichen:=1;
while i<=length(s) do begin
getword(wort,i);
if ((zeilezeichen mod maxx) +length(wort)>=maxx-1) and (wort<>'%') then begin
writeln;
zeilezeichen:=1;
end;
if wort[1]='@' then begin
textbackground(link);
delete(wort,1,1);
write(wort);
textbackground(bkgcolor);
write(' ');
inc(zeilezeichen,length(wort)+1);
inc(i);
end
else if wort='%' then begin
writeln;
wort:='';
zeilezeichen:=1;
end else begin
inc(zeilezeichen,length(wort)+1);
write(wort+' ');
end;
i:=i+length(wort)+1;
end;
end;
function mousebackground:byte;
begin
mousebackground:=mem[$b800:mousey div 8*160+ mousex div 8*2+1] shr 4;
end;
function string_under_mouse:string;
var ad:integer;
s :string;
begin
ad:=mousey div 8*160+ mousex div 8*2;
s:='';
while mem[$b800:ad]<>32 do begin
s:=s+chr(mem[$b800:ad]);
inc(ad,2);
end;
ad:=mousey div 8*160+ mousex div 8*2-2;
while mem[$b800:ad]<>32 do begin
s:=chr(mem[$b800:ad])+s;
dec(ad,2);
end;
string_under_mouse:=s;
end;
procedure openhelpfile;
begin
helpok:=true;
assign(helpfile,'help.hlp');
{$I-}
reset(helpfile);
if ioresult<>0 then begin
helpok:=false;
writeln('Hilfedatei nicht gefunden! Return!');
readln;
end;
{$I+}
end;
procedure closehelpfile;
begin
{$I-}
if helpok then close(helpfile);
{$I+}
end;
procedure ersetzen(var s:string;adresse,badresse:byte);
var i:byte;
newstring:string;
begin
while pos('#',s)<>0 do begin
i:=pos('#',s);
if s[i+1]='b' then begin
delete(s,i,5);
str(badresse,newstring);
end else begin
delete(s,i,4);
str(adresse,newstring);
end;
if badresse=255 then newstring:='xx';
insert(newstring,s,i);
end;
end;
function searchtopic(s:string):string;
var j :word;
helptext:string;
wort1 :string;
begin
wort1:='';
seek(helpfile,0);
while not eof(helpfile) and (wort1<>s) do begin
wort1:='';
read(helpfile,helptext);
j:=1;
while helptext[j]<>' ' do begin
wort1:=wort1+helptext[j];
inc(j);
end;
end;
searchtopic:=helptext;
end;
procedure help(data:tbefehl;adresse:word);
var befstr :string;
helptext :string;
begin
if helpok then begin
befstr:=befehlswort[data.operation];
helptext:=searchtopic(befstr);
ersetzen(helptext,data.adresse,adresse);
printtext(helptext,38);
end;
end;
procedure help2(s:string);
var i:byte;
helptext:string;
begin
if helpok then begin
helptext:=searchtopic(s);
clrscr;
printtext(helptext,38);
end;
end;
procedure mouseinhelp;
var s :string;
c,i :byte;
data :tbefehl;
begin
mousehide;
s:=string_under_mouse;
c:=mousebackground;
i:=0;
setwindow(HILFE);
if c=link then begin
if length(s)>3 then help2(s)
else begin
while befehlswort[toperation(i)]<>s do inc(i);
data.operation:=toperation(i);
data.adresse:=255;
clrscr;
help(data,255);
end;
end;
mouseshow;
mousestatus;
end;
Procedure laden(name:string;var p:tprogrammspeicher;var w:integer);
var f :text;
s :string;
load :boolean;
procedure init(n:string; var p:tprogrammspeicher);
var i :integer;
begin
clrscr;
for i:=1 to 255 do
begin
p[i].operation:=HLT;
p[i].adresse:=99;
datamem[i]:=0;
end;
{$I-}
assign(f,n);
reset(f);
if ioresult<>0 then load:=false else load:=true;
{$I+}
end;
procedure lade(var w:integer;var p:tprogrammspeicher);
var q,e :integer;
s1 :string;
fehl :boolean;
r :tOperation;
Begin
w:=1;
fehl:=false;
while not(eof(f)) and not(fehl) do begin
fehl:=true;
readln(f,s);
s1:=copy(s,1,3);
for e:= 1 to 3 do s1[e]:=upcase(s1[e]);
s :=copy(s,5,3);
val(s,q,e);
if e=0 then begin
for e:=1 to 16 do begin
if s1=befehlswort[toperation(e-1)] then begin
p[w].operation:=toperation(e-1);
p[w].adresse:=q;
fehl:=false;
end
end;
inc(w);
end;
end;
dec(w);
End;
procedure ende;
begin
close(f);
end;
Begin
init(name,p);
if load then begin
lade(w,p);
ende;
end;
End;
procedure frame(what:eFrames);
var i, j : Byte;
s0, s1, s2 : string[80];
begin
gotoxy(cFrames[what].x, cFrames[what].y);
textcolor(cFrames[what].c1);
textbackground(cFrames[what].c2);
fillchar(s0,cFrames[what].l-length(cFrames[what].framet),'Ä');
s0[0] := chr(cFrames[what].l-1-length(cFrames[what].framet));
fillchar(s1,cFrames[what].l,'Ä');
s1[0] := chr(cFrames[what].l-1);
fillchar(s2,cFrames[what].l,' ');
s2[0] := chr(cFrames[what].l-1);
write('Ú', cFrames[what].framet, s0, '¿');
for i := 1 to cFrames[what].h do
begin
gotoxy(cFrames[what].x, wherey+1);
write('³',s2,'³');
end;
gotoxy(cFrames[what].x, wherey+1);
write('À', s1, 'Ù');
end;
procedure showDesktop;
begin
setwindow(SCREEN);
textbackground(black);
clrscr;
textcolor(yellow);
gotoxy(19, 1);
write(' --- SIMULATION EINER REGISTERMASCHINE --- ');
gotoxy(19, 2);
write(' --------------------------------------- ');
frame(MONITOR);
frame(HILFE);
frame(HOTKEYS);
frame(PROGSPEICHER);
frame(DATSPEICHER);
frame(PROZESSOR);
(* Datenleitungen *)
textcolor(white);
textbackground(black);
gotoxy(01,10); write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
gotoxy(01,11); write('³');
gotoxy(01,12); write('ÀÄ');
gotoxy(18,12); write('ÄÄÄ');
gotoxy(60,10); write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
gotoxy(79,11); write('³');
gotoxy(78,12); write('ÄÙ');
gotoxy(60,12); write('ÄÄÄ');
textbackground(green);
gotoxy(20,10); write('Ä');
gotoxy(60,10); write('Ä');
gotoxy(20,12); write('Ä');
gotoxy(60,12); write('Ä');
gotoxy(02,12); write('Ä');
gotoxy(14,12); write('ÄÄÄÄÄ');
gotoxy(62,12); write('Ä');
gotoxy(78,12); write('Ä');
(* fr Hotkeys *)
setWindow(HOTKEYS);
textColor(green);
writeln('Weiter:"Return"');
writeln('Laden :"l"');
writeln('Neustart:"n"');
write ('Ende :"ESC"');
(* fr Prozessor*)
setWindow(PROZESSOR);
write(' ÚÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ');
write('ÚÄÄÄÄ´Befehls-³ ³Akkumulator³ ');
write('³ ³ zhler ³ ÃÄÄÄÄÄÂÄÄÄÄÄ´ ');
write('³ ÀÄÄÄÂÄÄÄÄÙ ÚÄ´ ... ³ ... ÃÄ¿ ');
write('³ ³ ÚÄÄÄÄÄÄÄÄ¿³ ÀÄÄÄÄÄÁÄÄÄÄÄÙ ³ ');
write('³ ÚÄÄÄÄÄÄÁÄÁÄÄÄÄÄÄ¿ ³³ ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ³ ');
write('Ù ³Befehlsregister³ ÀÅÄ´ ... ³ ÀÄ');
write(' ÃÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄ´ ³ ÃÄÄÄÄÄÂÄÄÄÄÄ´ ');
write('¿ ³ ... ³ ... ÃÄ¿ÀÄ´ ... ³ ... ³ ÚÄ');
write('³ ÀÄÄÄÂÄÄÄÁÄÄÂÄÄÄÄÙ ³ ÀÄÄÄÄÄÁÄÄÄÄÄÙ ³ ');
write('ÀÄÄÄÄÄÁÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
setWindow(SCREEN);
end;
procedure printByte(b:tDatum);
begin
if abs(b)<10 then write(' ')
else if abs(b)<100 then write(' ');
write(b);
end;
procedure showProgMem;
var i : Byte;
begin
setWindow(PROGSPEICHER);
textcolor(yellow);
for i := 1 to cFrames[PROGSPEICHER].h do
begin
gotoxy(1, i);
write('$');
printbyte(i+ip-1);
gotoxy(5,i);
write(':',befehlswort[progMem[ip+i-1].operation],' ');
printByte(progMem[ip+i-1].adresse);
end;
end;
procedure showDataMem;
var i,h : Byte;
begin
setWindow(DATSPEICHER);
textcolor(yellow);
h:=progMem[ip].adresse-1;
for i := 1 to cFrames[DATSPEICHER].h do
begin
gotoxy(1, i);
write('$');
printbyte(i);
gotoxy(5,i);
write(': ');
printByte(dataMem[i]);
end;
end;
procedure showAll;
begin
showDataMem;
showProgMem;
setWindow(PROZESSOR);
textcolor(red);
gotoxy(7,9);
write(befehlswort[progMem[ip].operation]);
gotoxy(13,9);
printByte(progMem[ip].adresse);
gotoxy(26,9);
printByte(ax);
gotoxy(32,9);
printByte(dataMem[progMem[ip].adresse]);
gotoxy(29,7);
write(befehlswort[progMem[ip].operation]);
gotoxy(26,4);
printByte(ax);
gotoxy(32,4);
printByte(dataMem[progMem[ip].adresse]);
setwindow(HILFE);
clrscr;
help(progmem[ip],ip);
end;
procedure interpreter(key:char);
var i:string;
j:integer;
begin
case key of
#13:begin
case progMem[ip].operation of
LDA:ax:=dataMem[progMem[ip].adresse];
LDK:ax:=progMem[ip].adresse;
STA:dataMem[progMem[ip].adresse]:=ax;
ADD:ax:=ax+dataMem[progMem[ip].adresse];
SUB:ax:=ax-dataMem[progMem[ip].adresse];
MUL:ax:=ax*dataMem[progMem[ip].adresse];
DIW:ax:=ax div dataMem[progMem[ip].adresse];
JMP:ip:=progMem[ip].adresse-1;
JEZ:if ax=0 then ip:=progMem[ip].adresse-1;
JNE:if ax<>0 then ip:=progMem[ip].adresse-1;
JLZ:if ax<0 then ip:=progMem[ip].adresse-1;
JLE:if ax<=0 then ip:=progMem[ip].adresse-1;
JGZ:if ax>0 then ip:=progMem[ip].adresse-1;
JGE:if ax>=0 then ip:=progMem[ip].adresse-1;
INP:begin
setWindow(MONITOR);
gotoxy(1,monitorSpalte);
write('$',progMem[ip].adresse,':=');
readln(I);
val(i,dataMem[progMem[ip].adresse],j);
dataMem[progMem[ip].adresse]:=dataMem[progMem[ip].adresse] mod 255;
monitorSpalte:=whereY;
end;
OUT:begin
setWindow(MONITOR);
gotoxy(1,monitorSpalte);
write('"',datamem[progMem[ip].adresse],'"');
monitorSpalte:=whereY;
end;
end;
inc(ip);
datamem[0]:=ax;
mouseHide;
showAll;
mouseShow;
mousestatus;
end;
'L':begin
setWindow(MONITOR);
gotoxy(1,monitorSpalte);
write('Lade:');
readln(fileName);
laden(fileName,progMem,l);
ip:=1;
monitorSpalte:=whereY;
mouseHide;
showAll;
mouseShow;
mousestatus;
end;
'N':begin
for j:=0 to 255 do datamem[j]:=0;
ip:=1;
mouseHide;
showAll;
mouseShow;
mousestatus;
end;
end;
end;
procedure run;
var key:char;
begin
ip:=1;
monitorSpalte:=1;
key:=#0;
mouseInit;
showAll;
mouseShow;
mousestatus;
while (key<>#27) do
begin
key:=#0;
if keypressed then key:=upcase(readkey);
getMouseStatus;
if button=1 then begin
mousehide;
if mousebackground=link then begin
mouseshow;
mousestatus;
getmousestatus;
mouseinhelp;
delay(500);
end
else begin
mouseshow;
mousestatus;
getmousestatus;
if mousein(cFrames[HOTKEYS].x shl 3,cFrames[HOTKEYS].y shl 3,
(cFrames[HOTKEYS].x+cFrames[HOTKEYS].l-2) shl 3,
(cFrames[HOTKEYS].y+cFrames[HOTKEYS].h-1) shl 3) then
case ((mouseY shr 3)-cFrames[HOTKEYS].y) of
0:key:=#13;
1:key:='L';
2:key:='N';
3:key:=#27;
end;
end;
end;
interpreter(key);
end;
end;
BEGIN
openhelpfile;
laden('prog.dat',progMem,l);
showDesktop;
run;
closehelpfile;
END.
| HOME | NEWS | AWARDS | ABOUT ME | TEXTE | REFERATE | PROJEKTE |
| MUSIK
| CHAT
| SPECIAL | LINKS |