|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen RC759 "Piccoline" |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen RC759 "Piccoline" Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 58711 (0xe557)
Types: TextFile
Names: »CPIGRAF.PAS«
└─⟦d4ddf50a0⟧ Bits:30004478 CPI-graf 2.5 til Piccoline/Partner
└─⟦this⟧ »CPIGRAF.PAS«
æ$A+,B-,D+,E-,F-,I-,L-,N-,O-,R-,S-,V-å
UNIT cpigraf;
INTERFACE
(*------------------------------------------------------------------------*)
(* CPI-graf 2.5 *)
(* (November 1988) *)
(* Copyright Dansk Center For P▶91◀dagogik og Informatik 1986 *)
(* Peter Ferdinand *)
(* Version til TUBO PASCAL version 5.0 *)
(* *)
(* En r▶91◀kke procedurer i PolyPascal beregnet til AT inds▶91◀tte i et pro- *)
(* gram. Procedurerne betyder AT brugeren f▶86◀r en ensartet grafisk gr▶91◀- *)
(* seflade uanset typen af datamat. Der kan defineres vinduer i b▶86◀de *)
(* grafik- og teksttilstand i disse vinduer kan der udskrives til *)
(* sk▶91◀rmen meget hurtigt og udenom styresystemet. *)
(* *)
(* Datamater som underst▶9b◀ttes er: *)
(* IBM PC med Color Graphic Apapter (640 * 200 pixels) *)
(* IBM PC med Enhanced Color Adapter (640 * 350 pixels) *)
(* IBM PC med Hercules adapter (720 * 350 pixels) *)
(* IBM PS2/30 med MCGA adapter (640 * 480 pixels) *)
(* Regnecentralen Partner (720 * 352 pixels) *)
(* Regnecentralen Piccoline (560 * 256 pixels) *)
(* *)
(* Procedurerne vil let kunne tilpasses alle datamater, hvor brugeren *)
(* har adgang til lageret for det grafiske sk▶91◀rmbillede. *)
(* *)
(*------------------------------------------------------------------------*)
USES dos, crt;
CONST
BLACK = 0;
WHITE = $FF;
TRANSP = 01;
Wnd_Max = 8;
CharFilName = '8x8font.SET';
Txt_mode : BOOLEAN = TRUE;
NULL = #0;
ESC = #27;
BLANK = ' ';
Fenter= #13;
F1 = #59 ; F2 = #60 ;
F3 = #61 ; F4 = #62 ;
F5 = #63 ; F6 = #64 ;
F7 = #65 ; F8 = #66 ;
F9 = #67 ; F10 = #68 ;
Fhome = #71 ; Fup = #72 ;
Fpgup = #73 ; Fleft = #75 ;
Fright= #77 ; Fend = #79 ;
Fdown = #80 ; Fpgdn = #81 ;
Fins = #82 ; Fdel = #83 ;
(* Fore- AND backgroundcolors*)
(* LightTxt only works FOR foregroundcolors*)
(* BlinkTxt only works FOR backgroundcolors *)
blackTxt = 0; blueTxt = 1;
greenTxt = 2; cyanTxt = 3;
redTxt = 4; magentaTxt= 5;
yellowTxt = 6; whiteTxt = 7;
lightTxt = 8; blinkTxt = 8;
TYPE
Buftype1 = ARRAY(.0..$7FFF.) OF BYTE;
Buftype = ^Buftype1;
str80 = STRING(.100.);
Wnd_artset = (Wtext,Wmenu,Wnonhide,Wdrawframe,Wwriteframe);
Wnd_art = SET OF Wnd_artset;
Wnd_Type1 = RECORD
x1, y1 : INTEGER;
maxx, maxy : INTEGER;
Txtx1, Txty1 : INTEGER;
Txtmaxx, Txtmaxy : INTEGER;
END;
Wnd_Id =^Wnd_Type;
Wnd_Type = RECORD
next : Wnd_Id;
inner : Wnd_type1;
outer : Wnd_type1;
x1, y1 : REAL;
xrange, yrange : REAL;
xold, yold : INTEGER;
pencolor, backcolor : INTEGER;
paletteno : INTEGER;
hdr : str80;
art : Wnd_art;
Txtinit : Buftype;
content : Buftype;
bytes : WORD;
END;
charfiltype = ARRAY(.0..255.) OF ARRAY(.0..7.) OF BYTE;
Txt_linechar = RECORD
CASE BOOLEAN OF
TRUE : (ch: CHAR; att: BYTE);
false :(both: INTEGER);
END;
Sys_filtype = (Fil_Read,Fil_Write);
Scr_Type = (IBM_High, IBM_Mcga, OLI_High, IBM_Enhan, IBM_Herc, Par_High, Pic_High);
Prn_Type = (IBM_graph, Rc_603);
Txt_line = ARRAY(.0..80.) OF Txt_linechar;
Txt_charset = SET OF CHAR;
Txt_converttype = (none,to_iso,to_ibm);
VAR
Scr_maxx : INTEGER;
Scr_maxy : INTEGER;
Scr_segm : WORD;
Scr_aspect : INTEGER;
Scr_xaddr : ARRAY(.0..720.) OF INTEGER;
Scr_yaddr : ARRAY(.0..480.) OF INTEGER;
Scr_lgt : INTEGER;
(* f▶9b◀lgende variable SKAL ligge i forl▶91◀ngelse af hinanden *)
Wnd_x1, Wnd_y1 : INTEGER;
Wnd_maxx, Wnd_maxy : INTEGER;
Wnd_Txtx1, Wnd_Txty1 : INTEGER;
Wnd_Txtmaxx, Wnd_Txtmaxy : INTEGER;
Wld_x1, Wld_y1 : REAL;
Wld_xrange, Wld_yrange : REAL;
Wld_xold, Wld_yold : INTEGER;
Wnd_pencolor, Wnd_backcolor : INTEGER;
Wnd_paletteno : INTEGER;
Wnd_hdr : str80;
(* hertil *)
Wnd_palette : ARRAY(.0..15.) OF BYTE;
reg : registers;
Scr_start : INTEGER;
Scr_pattern : word;
graph_Type : Scr_Type;
Txt_lineptr : ARRAY(.0..24.) OF ^Txt_line;
Txt_maxx : INTEGER;
Txt_maxy : INTEGER;
char1, char2 : CHAR;
Sys_FILE : FILE;
Sys_buf : ARRAY(.0..127.) OF BYTE;
Sys_bufptr : INTEGER;
Sys_eof : boolean;
(* f▶9b◀lgende variable SKAL ligge i forlængelse af hinanden *)
Sys_lgt : INTEGER;
Sys_TO,
Sys_from,
Sys_xlgt,
Sys_ylgt,
Sys_totlgt : BYTE;
Scr_CHAR : charfiltype;
(* hertil *)
WholeScreen : Wnd_Id ;
Wnd_actual : Wnd_Id ;
wnd_help : Wnd_Id ;
CONST
Txt_convert : Txt_converttype = none;
PROCEDURE Sys_openfile(navn: str80;filtyp: Sys_filtype; VAR err: BOOLEAN);
PROCEDURE Sys_closefile(filtyp: Sys_filtype);
PROCEDURE Sys_readfile(no: INTEGER;VAR dest);
PROCEDURE Sys_writefile(no: INTEGER; VAR dest);
PROCEDURE Scr_textconvert(VAR s: str80; convert: Txt_converttype);
PROCEDURE error(errno :byte);
PROCEDURE setcursoroff;
PROCEDURE setcursoron;
PROCEDURE writestr(col,row: INTEGER; str: str80);
PROCEDURE graphmode;
PROCEDURE textmode;
FUNCTION spc(l: INTEGER; ch: CHAR):str80;
PROCEDURE swapi(VAR a,b: INTEGER);
PROCEDURE Scr_dump(mode:prn_Type);
PROCEDURE Scr_fillchar(x1,y1,x2,y2:INTEGER; color: BYTE);
FUNCTION _wld_towindowx(x: real): INTEGER;
FUNCTION _wld_towindowy(y: real): INTEGER;
PROCEDURE Wnd_WriteDot(x, y: INTEGER);
FUNCTION Wnd_ReadDot(x, y : INTEGER) : BOOLEAN;
PROCEDURE Wnd_DrawLine(x1, y1, x2, y2: INTEGER);
PROCEDURE Wnd_DrawBox(x1, y1, x2, y2 : INTEGER);
PROCEDURE Wnd_Drawtext(x, y : INTEGER; c : str80);
PROCEDURE Wnd_circle(cx, cy, radius: INTEGER);
PROCEDURE fenceviewport(VAR v: Wnd_id);
PROCEDURE plot(x, y : REAL);
PROCEDURE circle(x,y,r: REAL);
FUNCTION getcolor(x, y : REAL): BOOLEAN;
PROCEDURE moveto(x,y:REAL);
PROCEDURE Drawto(x2, y2 : REAL);
PROCEDURE DrawText(x, y: REAL; s: str80);
PROCEDURE WriteText(col,row:INTEGER;s:str80);
PROCEDURE WriteReal(x,y:INTEGER; r:REAL; l,d: INTEGER);
PROCEDURE DrawBox(x1, x2, y1, y2 : REAL);
PROCEDURE BoxWindow;
PROCEDURE drawheader;
PROCEDURE drawframe;
PROCEDURE gotoxy(x,y: INTEGER);
PROCEDURE clearviewport;
PROCEDURE writeframe;
PROCEDURE writehelp;
PROCEDURE saveviewport(VAR v: Wnd_id);
PROCEDURE Loadviewport(VAR v: Wnd_id);
PROCEDURE swapviewport(VAR v: Wnd_id);
PROCEDURE selectviewport(VAR v: Wnd_id);
PROCEDURE hideviewport(VAR v: Wnd_id);
PROCEDURE closeviewport(VAR v: Wnd_id);
PROCEDURE SetWindow(v: Wnd_id; xx1, xx2, yy1, yy2 : REAL);
PROCEDURE setviewportcolor(VAR v: Wnd_id; fcolor, bcolor: INTEGER);
PROCEDURE setpalette(no, fcolor, bcolor: BYTE);
PROCEDURE settextviewportcolor(VAR v: Wnd_id; no: BYTE);
PROCEDURE setviewportheader(VAR v: Wnd_id; h: str80);
PROCEDURE newviewport(VAR v: Wnd_id; xx1, xx2, yy1, yy2: INTEGER);
PROCEDURE newtextviewport(VAR v: Wnd_id; xx1, xx2, yy1, yy2: INTEGER);
PROCEDURE newviewporttextmap(VAR v: Wnd_id; x1, x2, y1, y2: INTEGER;VAR Txt);
PROCEDURE GraphicScreen(typ :Scr_Type);
PROCEDURE moveviewport(x,y: INTEGER);
PROCEDURE movetextviewport(x,y: INTEGER);
PROCEDURE newviewportbitmap(VAR v: Wnd_id; x,y: INTEGER; name: str80;VAR err: BOOLEAN);
PROCEDURE setviewporttype(VAR v: Wnd_id; vart: Wnd_art);
PROCEDURE readchar;
PROCEDURE inputstr(VAR s:str80;term:Txt_charset;VAR xx:INTEGER;x,y,l:INTEGER;VAR changed,inset:BOOLEAN);
PROCEDURE drawaxis(xdens1,ydens1: REAL; gitter: boolean);
IMPLEMENTATION
CONST
help: ARRAY(.0..7.) OF STRING (.40.)= (
'<HOME> mark▶9b◀r til tekststart',
'<END> mark▶9b◀r til tekstslut',
'<DEL> slet tegn p▶86◀ mark▶9b◀rens plads',
'<INS> skift mellem overskriv og inds▶91◀t',
'<^Y> slet linie fra mark▶9b◀rens plads',
'<▶11◀'#196'> slet tegn til venstre FOR mark▶9b◀r',
'<▶1b◀> ryk mark▶9b◀r en plads til venstre',
'<'#26'> ryk mark▶9b◀r en plads til h▶9b◀jre');
type
buftypepartner = arrayÆ0..$2000Å of byte;
var
gcb_rec:record
gcb_mx:byte;
gcb_seg:integer;
end;
gr_buffer:^buftypepartner;
pic_mono:boolean;
sysdat,pd_addr,ccb_addr:integer;
VAR
bit_lgt,bit_xxlgt,bit_yylgt,bit_xofs,bit_yofs: INTEGER;
bit_mask,bit_bit,bit_selector: BYTE;
bit_ellen, bit_temp: BYTE;
displaylist : Wnd_Id ;
hiddenlist : Wnd_Id ;
ExitSave : Pointer;
(*Procedurer anvendes til hurtig og typefri ind/udl▶91◀sning af data*)
PROCEDURE Sys_openfile(navn: str80;filtyp: Sys_filtype; VAR err: BOOLEAN);
BEGIN
Sys_eof:=false;
assign(Sys_FILE,navn);
IF filtyp=Fil_Read THEN BEGIN
reset(Sys_FILE);
Sys_Bufptr:=128
END ELSE BEGIN
Sys_Bufptr:=0;
rewrite(Sys_FILE);
END;
err:=(ioresult<>0);
END;
PROCEDURE Sys_closefile(filtyp: Sys_filtype);
VAR i: INTEGER;
BEGIN
IF (filtyp=Fil_Write) THEN blockwrite(Sys_FILE,Sys_Buf,1,i);
close(Sys_FILE);
END;
PROCEDURE Sys_readfile(no: INTEGER;VAR dest);
VAR
ii,i,adrseg, adrofs: INTEGER;
BEGIN
adrseg:=seg(dest); adrofs:=ofs(dest);
FOR i:=1 TO no DO BEGIN
IF Sys_Bufptr>127 THEN BEGIN
blockread(Sys_FILE,Sys_Buf,1,ii); Sys_Bufptr:=0;END;
mem(.adrseg:adrofs.):=Sys_Buf(.Sys_Bufptr.);
adrofs:=adrofs+1;
Sys_Bufptr:=Sys_Bufptr+1;
END;
END;
PROCEDURE Sys_writefile(no: INTEGER; VAR dest);
VAR
ii,i,adrseg, adrofs: INTEGER;
BEGIN
adrseg:=seg(dest); adrofs:=ofs(dest);
FOR i:=1 TO no DO BEGIN
IF Sys_Bufptr>127 THEN BEGIN
blockwrite(Sys_FILE,Sys_Buf,1,ii); Sys_Bufptr:=0;END;
Sys_Buf(.Sys_Bufptr.):=mem(.adrseg:adrofs.);
adrofs:=adrofs+1;
Sys_Bufptr:=Sys_Bufptr+1;
END;
END;
PROCEDURE Scr_textconvert(VAR s: str80; convert: Txt_converttype);
CONST
ibm_chars : string(.6.) = #145#155#134#146#157#143;
iso_chars : string(.6.) = #123#124#125#91#92#93;
VAR
i,j : INTEGER;
BEGIN
if convert=none then exit;
for i:=1 to length(s) do begin
if convert=to_iso then begin
j:=pos(s(.i.),ibm_chars);
if j>0 then s(.i.):=iso_chars(.j.);
end
else begin
j:=pos(s(.i.),iso_chars);
if j>0 then s(.i.):=ibm_chars(.j.);
end;
end;
end;
(*I------------------------------------------------------------------------I*)
(*I De efterf▶9b◀lgende procedurer er maskinspecifikke. De er de I*)
(*I eneste som skal udskiftes hvis programmet skal tilpasses en anden I*)
(*I datamattype. I*)
(*I I*)
(*I------------------------------------------------------------------------I*)
æ$F+å
PROCEDURE errorproc;
begin
if not txt_mode then
begin
reg.ax:=$0001;
intr($28,reg);
end;
reg.ax:=$100;
reg.cx:=1543;
intr($10,reg);
exitproc:=Exitsave;
if exitcode>0 then
writeln('K▶9b◀rselsfejl ved CPI-graf (se s. 467):',exitcode);
end;
æ$F-å
PROCEDURE error(errno :byte);
BEGIN
setcursoron;
textmode;
writeln('Fejl ved anvendelsen af CPI-graf :');
case errno of
1: writeln('CPI-graf: Systemfonten findes ikke i aktive bibliotek');
2: Writeln('CPI-menu: Ikke plads til flere ressourcer i interne lager');
3: Writeln('CPI-graf: Vindue er ikke defineret');
4: Writeln('CPI-graf: Procedure kan kun anvendes i grafiktilstand');
5: Writeln('CPI-menu: Valgtegn er ikke defineret');
6: Writeln('CPI-font: Fonten findes ikke i aktive bibliotek');
7: Writeln('CPI-graf: Vindueskoordinater er uden af justering');
8: Writeln('CPI-graf: Lageret er opbrugt - brug "standalone" kompiler');
9: Writeln('CPI-menu: Ressourcerne er ikke defineret');
end;
halt;
END;
PROCEDURE setcursoroff;
BEGIN
reg.ax:=$100;
reg.cx:=$0f0f;
intr($10,reg);
END;
PROCEDURE setcursoron;
BEGIN
reg.ax:=$100;
reg.cx:=1543;
intr($10,reg);
END;
procedure init_text;
type
linptrtype=arrayÆ0..24Å of integer;
var x,i:integer;
linptr:^linptrtype;
begin
reg.ax:=0021;
intr($28,reg);
linptr:=ptr(reg.es,reg.bx);
if vpc then
begin
for i:=0 to 24 do
txt_lineptrÆiÅ:=ptr($b000,i*160);
end
else
begin
for i:=0 to 24 do
txt_lineptrÆiÅ:=ptr(reg.dx,linptr^ÆiÅ);
end;
end;
procedure writestr(col,row:integer;str:str80);
var
attrib:byte;
begin
textattr:=wnd_paletteÆwnd_palettenoÅ;
crt.gotoxy(col+1,row+1);
write(str);
end;
PROCEDURE init_graphics(typ: Scr_TYPE);
VAR
Scr_MOD, i: INTEGER;
charfil:file of charfiltype;
fi:file of integer;
scrtyp:^byte;
gr_maxxx:integer;
k,a,b:integer;
ch:char;
ss:^byte;
err:boolean;
BEGIN
reg.ax:=$03;
intr($28,reg);
scrtyp:=ptr(reg.es,reg.si+53);
if scrtyp^=0 then
scr_segm:=$f000
else
scr_segm:=$d000;
reg.ax:=$04;
intr($28,reg);
scrtyp:=ptr(reg.es,reg.si+18);
pic_mono:=(scrtyp^=1);
if scrtyp^ and 2=2 then
begin
graph_type:=par_high;
k:=14;
scr_maxx:=719;
scr_maxy:=343;
gr_maxxx:=704;
scr_aspect:=130;
end
else
begin
k:=10;
graph_type:=pic_high;
scr_maxx:=559;
scr_maxy:=255;
gr_maxxx:=512;
scr_aspect:=200;
end;
a:=-gr_maxxx;
b:=0;
for i:=0 to scr_maxx do
begin
if (i mod 16)=0 then
a:=a+gr_maxxx;
if (i mod 8)=0 then
if b=1 then
b:=0
else
b:=1;
scr_xaddrÆiÅ:=a+b;
end;
for i:=0 to scr_maxy do
scr_yaddrÆscr_maxy-iÅ:=(i*2);
if maxavail>$7FFF then
getmem(gr_buffer,$7fff+$F)
else
error(1);
txt_maxx:=79;
txt_maxy:=24;
scr_lgt:=(scr_maxx+7) shr 3 * (scr_maxy+1);
sys_openfile(charfilname,fil_read,err);
if err then
error(1);
sys_readfile(7,sys_lgt);
sys_readfile(sys_lgt-7,scr_char);
sys_closefile(fil_read);
end;
PROCEDURE graphmode;
BEGIN
if txt_mode then
begin
txt_mode:=false;
txt_maxx:=Scr_maxx div 8;
txt_maxy:=scr_maxy div 8;
gcb_rec.gcb_mx:=$00;
gcb_rec.gcb_seg:=seg(Gr_Buffer^);
reg.ax:=$0100;
reg.cx:=ofs(gcb_rec);
reg.dx:=seg(gcb_rec);
intr($28,reg);
END;
END;
PROCEDURE textmode;
BEGIN
IF not txt_mode THEN BEGIN
init_text;
txt_maxx:=79;
txt_maxy:=24;
txt_mode:=true;
reg.ax:=$0001;
intr($28,reg);
clrscr;
END;
END;
(* Her slutter maskinspecifikke procedurer*)
FUNCTION spc(l: INTEGER; ch: CHAR):str80;
VAR
s : str80;
BEGIN
sÆ0Å:=char(l);
fillchar(s(.1.),l,ch);
spc:=s;
END;
PROCEDURE swapi(VAR a,b: INTEGER);
VAR c: INTEGER;
BEGIN
c:=a; a:=b; b:=c;
END;
PROCEDURE Scr_writedot(x,y: INTEGER);
begin
Inline(
$8B/$7E/<X/ æ MOV DI,ÆBP+<xÅå
$8B/$76/<Y/ æ MOV SI,ÆBP+<yÅå
$89/$F9/ æ MOV CX,DIå
$D1/$E7/ æ SHL DI,1å
$D1/$E6/ æ SHL SI,1å
$8B/$9D/>Scr_XADDR/ æ MOV BX,ÆDI+>Scr_XADDRÅå
$03/$9C/>Scr_YADDR/ æ ADD BX,ÆSI+>Scr_YADDRÅå
$80/$E1/$07/ æ AND CL,+$07å
$B2/$80/ æ MOV DL,-$80å
$D2/$EA/ æ SHR DL,CLå
$8E/$06/>Scr_SEGM/ æ MOV ES,Æ>Scr_SEGMÅå
$A0/>Wnd_PENCOLOR/ æ MOV AL,Æ>Wnd_PENCOLORÅå
$3C/$FF/ æ CMP AL,$FFå
$75/$05/ æ JNZ X43å
$26/ æ ES:å
$08/$17/ æ OR ÆBXÅ,DLå
$EB/$0E/ æ JMP SHORT X57å
$3C/$00/ æX43: CMP AL,$00å
$75/$07/ æ JNZ X54å
$F6/$D2/ æ NOT DLå
$26/ æ ES:å
$20/$17/ æ AND ÆBXÅ,DLå
$EB/$03/ æ JMP SHORT X57å
$26/ æX54: ES:å
$30/$17); æ XOR ÆBXÅ,DLå
æX57:å
end;
PROCEDURE Scr_WriteText(str:str80;x,y:INTEGER);
BEGIN
Inline(
$8B/$7E/<X/ æ MOV DI,ÆBP+<xÅå
$D1/$E7/ æ SHL DI,1å
$8E/$06/>Scr_SEGM/ æ MOV ES,Æ>Scr_SEGMÅå
$B2/$01/ æ MOV DL,+$01å
$3A/$56/<STR/ æX12: CMP DL,ÆBP+<strÅå
$7F/$54/ æ JG X99å
$52/ æ PUSH DXå
$B6/$00/ æ MOV DH,+$00å
$89/$D6/ æ MOV SI,DXå
$8A/$5A/<STR/ æ MOV BL,ÆBP+SI+<strÅå
$8B/$85/>Scr_XADDR/ æ MOV AX,ÆDI+>Scr_XADDRÅå
$8B/$76/<Y/ æ MOV SI,ÆBP+<yÅå
$81/$C6/$07/$00/ æ ADD SI,+$07å
$D1/$E6/ æ SHL SI,1å
$B7/$00/ æ MOV BH,+$00å
$D1/$E3/ æ SHL BX,1å
$D1/$E3/ æ SHL BX,1å
$D1/$E3/ æ SHL BX,1å
$B9/$08/$00/ æ MOV CX,$0008å
$8A/$B7/>Scr_CHAR/ æX48: MOV DH,ÆBX+>Scr_CHARÅå
$53/ æ PUSH BXå
$8B/$9C/>Scr_YADDR/ æ MOV BX,ÆSI+>Scr_YADDRÅå
$4E/ æ DEC SIå
$4E/ æ DEC SIå
$01/$C3/ æ ADD BX,AXå
$8A/$16/>Wnd_PENCOLOR/ æ MOV DL,Æ>Wnd_PENCOLORÅå
$80/$FA/$00/ æ CMP DL,+$00å
$74/$07/ æ JZ X77å
$7F/$0C/ æ JG X84å
$26/ æ ES:å
$88/$37/ æ MOV ÆBXÅ,DHå
$EB/$0A/ æ JMP SHORT X87å
$F6/$D6/ æX77: NOT DHå
$26/ æ ES:å
$88/$37/ æ MOV ÆBXÅ,DHå
$EB/$03/ æ JMP SHORT X87å
$26/ æX84: ES:å
$30/$37/ æ XOR ÆBXÅ,DHå
$5B/ æX87: POP BXå
$43/ æ INC BXå
$E2/$D5/ æ LOOP X48å
$81/$C7/$10/$00/ æ ADD DI,+$10å
$5A/ æ POP DXå
$FE/$C2/ æ INC DLå
$EB/$A7); æ JMP SHORT X12å
æX99:å
END;
PROCEDURE moveScr_tomem(x,y,xlen: INTEGER;k1,k2: INTEGER);
begin
Inline(
$8B/$7E/<Y/ æ MOV DI,ÆBP+<yÅå
$D1/$E7/ æ SHL DI,1å
$8B/$85/>Scr_YADDR/ æ MOV AX,ÆDI+>Scr_YADDRÅå
$8B/$4E/<XLEN/ æ MOV CX,ÆBP+<xlenÅå
$8B/$7E/<X/ æ MOV DI,ÆBP+<xÅå
$D1/$E7/ æ SHL DI,1å
$8E/$06/>Scr_SEGM/ æ MOV ES,Æ>Scr_SEGMÅå
$1E/ æ PUSH DSå
$C5/$76/<K2/ æ LDS SI,ÆBP+<k2Åå
$8C/$DA/ æ MOV DX,DSå
$89/$C3/ æX27: MOV BX,AXå
$1F/ æ POP DSå
$03/$9D/>Scr_XADDR/ æ ADD BX,ÆDI+>Scr_XADDRÅå
$1E/ æ PUSH DSå
$8E/$DA/ æ MOV DS,DXå
$51/ æ PUSH CXå
$26/ æ ES:å
$8A/$0F/ æ MOV CL,ÆBXÅå
$88/$0C/ æ MOV ÆSIÅ,CLå
$59/ æ POP CXå
$46/ æ INC SIå
$81/$C7/$10/$00/ æ ADD DI,+$10å
$E2/$E8/ æ LOOP X27å
$1F); æ POP DSå
end;
PROCEDURE movememtoScr_(x,y,xlen: INTEGER;k1,k2:INTEGER);
begin
Inline(
$8B/$7E/<Y/ æ MOV DI,ÆBP+<yÅå
$D1/$E7/ æ SHL DI,1å
$8B/$85/>Scr_YADDR/ æ MOV AX,ÆDI+>Scr_YADDRÅå
$8B/$4E/<XLEN/ æ MOV CX,ÆBP+<xlenÅå
$8B/$7E/<X/ æ MOV DI,ÆBP+<xÅå
$D1/$E7/ æ SHL DI,1å
$8E/$06/>Scr_SEGM/ æ MOV ES,Æ>Scr_SEGMÅå
$1E/ æ PUSH DSå
$C5/$76/<K2/ æ LDS SI,ÆBP+<k2Åå
$8C/$DA/ æ MOV DX,DSå
$89/$C3/ æX78: MOV BX,AXå
$1F/ æ POP DSå
$03/$9D/>Scr_XADDR/ æ ADD BX,ÆDI+>Scr_XADDRÅå
$1E/ æ PUSH DSå
$8E/$DA/ æ MOV DS,DXå
$51/ æ PUSH CXå
$8A/$0C/ æ MOV CL,ÆSIÅå
$26/ æ ES:å
$88/$0F/ æ MOV ÆBXÅ,CLå
$59/ æ POP CXå
$46/ æ INC SIå
$81/$C7/$10/$00/ æ ADD DI,+$10å
$E2/$E8/ æ LOOP X78å
$1F); æ POP DSå
end;
PROCEDURE fillvideoline(x,y,xlen,color: INTEGER);
begin
Inline(
$8B/$7E/<Y/ æ MOV DI,ÆBP+<yÅå
$D1/$E7/ æ SHL DI,1å
$8B/$85/>Scr_YADDR/ æ MOV AX,ÆDI+>Scr_YADDRÅå
$8B/$4E/<XLEN/ æ MOV CX,ÆBP+<xlenÅå
$8B/$7E/<X/ æ MOV DI,ÆBP+<xÅå
$8E/$06/>Scr_SEGM/ æ MOV ES,Æ>Scr_SEGMÅå
$8B/$56/<COLOR/ æ MOV DX,ÆBP+<colorÅå
$89/$C3/ æX124: MOV BX,AXå
$89/$FE/ æ MOV SI,DIå
$D1/$E6/ æ SHL SI,1å
$03/$9C/>Scr_XADDR/ æ ADD BX,ÆSI+>Scr_XADDRÅå
$26/ æ ES:å
$88/$17/ æ MOV ÆBXÅ,DLå
$81/$C7/$08/$00/ æ ADD DI,+$08å
$E2/$ED); æ LOOP X124å
end;
FUNCTION Scr_ReadDot(x,y:INTEGER):BOOLEAN;
VAR total: INTEGER;
BEGIN
total:=Scr_xaddr(.x.)+Scr_yaddr(.y.);
Scr_readdot:=
(Wnd_pencolor=BLACK) XOR (mem(.Scr_segm:total.) AND (128 SHR (x AND 7))<>0);
END;
PROCEDURE Scr_fillchar(x1,y1,x2,y2:INTEGER; color: BYTE);
VAR
y,l,xl,xr: INTEGER;
BEGIN
l:=(x2+7) SHR 3;
FOR y:=y1 TO y2 DO BEGIN
fillvideoline(x1,y,l,color);
END;
END;
procedure scr_drawLine(L_x1,L_y1,L_x2,L_y2 : integer);
æ adapted from J. D. Foley and A. van Dam, "Fundamentals of Interactive
Computer Graphics", Addison-Wesley, Reading, Massachusetts, 1984. å
var
L_dx,L_dy,L_sx,L_sy,L_i1,L_i2,L_er : integer;
begin
Inline(
$8B/$46/<l_x1/ æ mov ax,ÆBPÅ<l_x1å
$8B/$4E/<l_x2/ æ mov cx,ÆBPÅ<l_x2å
$8B/$56/<l_y2/ æ mov dx,ÆBPÅ<l_y2å
$31/$DB/ æ xor bx,bx ; check directionå
$29/$C8/ æ sub ax,cxå
$74/$08/ æ jz lxzå
$78/$03/ æ js lxså
$4B/ æ dec bxå
$EB/$03/ æ jmp short lxzå
$43/ ælxs: inc bxå
$F7/$D8/ æ neg axå
$89/$46/<l_dx/ ælxz: mov ÆBPÅ<l_dx,axå
$89/$5E/<l_sx/ æ mov ÆBPÅ<l_sx,bxå
$8B/$46/<l_y1/ æ mov ax,ÆBPÅ<l_y1 ; check y directionå
$31/$DB/ æ xor bx,bxå
$29/$D0/ æ sub ax,dxå
$74/$08/ æ jz lyzå
$78/$03/ æ js lyså
$4B/ æ dec bxå
$EB/$03/ æ jmp short lyzå
$43/ ælys: inc bxå
$F7/$D8/ æ neg axå
$89/$46/<l_dy/ ælyz: mov ÆBPÅ<l_dy,axå
$89/$5E/<l_sy/ æ mov ÆBPÅ<l_sy,bxå
$8B/$1E/>scr_pattern/ æ mov bx,Æ>scr_patternÅ ; initialize bx with patternå
$8B/$4E/<l_x1/ æ mov cx,ÆBPÅ<l_x1 ; initialize regs for BIOSå
$8B/$56/<l_y1/ æ mov dx,ÆBPÅ<l_y1å
$3B/$46/<l_dx/ æ cmp ax,ÆBPÅ<l_dx ; are we drawing mostly x or yå
$79/$41/ æ jns lydrawå
ælxdraw:å
$8B/$46/<l_dy/ æ mov ax,ÆBPÅ<l_dy ; calc i1,i2,errorå
$D1/$E0/ æ shl ax,1å
$89/$46/<l_i1/ æ mov ÆBPÅ<l_i1,ax ; i1 := 2*dyå
$2B/$46/<l_dx/ æ sub ax,ÆBPÅ<l_dxå
$89/$46/<l_er/ æ mov ÆBPÅ<l_er,ax ; er := 2*dy - dxå
$2B/$46/<l_dx/ æ sub ax,ÆBPÅ<l_dxå
$89/$46/<l_i2/ æ mov ÆBPÅ<l_i2,ax ; i2 := 2*dy - 2*dxå
$EB/$19/ æ jmp short lxplot ; start in middle of loopå
$03/$4E/<l_sx/ ælxloop: add cx,ÆBPÅ<l_sx ; x := x + 1å
$8B/$46/<l_er/ æ mov ax,ÆBPÅ<l_erå
$3D/$00/$00/ æ cmp ax,0å
$7D/$05/ æ jge lxy ; if er < 0 thenå
$03/$46/<l_i1/ æ add ax,ÆBPÅ<l_i1 ; er := er + i1å
$EB/$06/ æ jmp short lxpt ; elseå
$03/$46/<l_i2/ ælxy: add ax,ÆBPÅ<l_i2 ; er := er + i2å
$03/$56/<l_sy/ æ add dx,ÆBPÅ<l_sy ; y := y + 1å
$89/$46/<l_er/ ælxpt: mov ÆBPÅ<l_er,axå
ælxplot:å
$D1/$C3/ æ rol bx,1å
$72/$07/ æ jc lxskipå
$89/$CF/ æ mov di,cxå
$89/$D6/ æ mov si,dxå
$E8/$48/$00/ æ call plotå
$3B/$4E/<l_x2/ ælxskip: cmp cx,ÆBPÅ<l_x2 ; are we done?å
$75/$D7/ æ jne lxloopå
$EB/$7B/ æ jmp short slutå
ælydraw: ; comments are same as aboveå
$8B/$46/<l_dx/ æ mov ax,ÆBPÅ<l_dxå
$D1/$E0/ æ shl ax,1å
$89/$46/<l_i1/ æ mov ÆBPÅ<l_i1,axå
$2B/$46/<l_dy/ æ sub ax,ÆBPÅ<l_dyå
$89/$46/<l_er/ æ mov ÆBPÅ<l_er,axå
$2B/$46/<l_dy/ æ sub ax,ÆBPÅ<l_dyå
$89/$46/<l_i2/ æ mov ÆBPÅ<l_i2,axå
$EB/$19/ æ jmp short lyplotå
$03/$56/<l_sy/ ælyloop: add dx,ÆBPÅ<l_syå
$8B/$46/<l_er/ æ mov ax,ÆBPÅ<l_erå
$3D/$00/$00/ æ cmp ax,0å
$7D/$05/ æ jge lyxå
$03/$46/<l_i1/ æ add ax,ÆBPÅ<l_i1å
$EB/$06/ æ jmp short lyptå
$03/$46/<l_i2/ ælyx: add ax,ÆBPÅ<l_i2å
$03/$4E/<l_sx/ æ add cx,ÆBPÅ<l_sxå
$89/$46/<l_er/ ælypt: mov ÆBPÅ<l_er,axå
ælyplot:å
$D1/$C3/ æ rol bx,1å
$72/$07/ æ jc lyskipå
$89/$CF/ æ mov di,cxå
$89/$D6/ æ mov si,dxå
$E8/$07/$00/ æ call plotå
$3B/$56/<l_y2/ ælyskip: cmp dx,ÆBPÅ<l_y2å
$75/$D7/ æ jne lyloopå
$EB/$3A/ æ jmp short slutå
$52/ æplot: push dxå
$51/ æ push cxå
$53/ æ push bxå
$50/ æ push axå
$D1/$E7/ æ SHL DI,1å
$D1/$E6/ æ SHL SI,1å
$8B/$9D/>Scr_XADDR/ æ MOV BX,ÆDI+>Scr_XADDRÅå
$03/$9C/>Scr_YADDR/ æ ADD BX,ÆSI+>Scr_YADDRÅå
$80/$E1/$07/ æ AND CL,+$07å
$B2/$80/ æ MOV DL,-$80å
$D2/$EA/ æ SHR DL,CLå
$8E/$06/>Scr_SEGM/ æ MOV ES,Æ>Scr_SEGMÅå
$A0/>Wnd_PENCOLOR/ æ MOV AL,Æ>Wnd_PENCOLORÅå
$3C/$FF/ æ CMP AL,$FFå
$75/$05/ æ JNZ X43å
$26/ æ ES:å
$08/$17/ æ OR ÆBXÅ,DLå
$EB/$0E/ æ JMP SHORT X57å
$3C/$00/ æX43: CMP AL,$00å
$75/$07/ æ JNZ X54å
$F6/$D2/ æ NOT DLå
$26/ æ ES:å
$20/$17/ æ AND ÆBXÅ,DLå
$EB/$03/ æ JMP SHORT X57å
$26/ æX54: ES:å
$30/$17/ æ XOR ÆBXÅ,DLå
æX57:å
$58/ æ pop axå
$5B/ æ pop bxå
$59/ æ pop cxå
$5A/ æ pop dxå
$C3); æ retå
æslut:å
end;
FUNCTION isqrt(arg: INTEGER):INTEGER;
VAR
odd_int, old_arg, first_sqrt: INTEGER;
BEGIN
odd_int:=1; old_arg:=arg;
WHILE arg>=0 DO BEGIN
arg:=arg-odd_int;
odd_int:=odd_int+2;
END;
first_sqrt:=odd_int SHR 1;
IF sqr(first_sqrt)-first_sqrt+1>old_arg THEN
isqrt:=first_sqrt-1 ELSE isqrt:=first_sqrt;
END;
PROCEDURE Scr_getpic(VAR pic; x1, y1, xlg2, ylg2: INTEGER);
VAR
y, k1, k2: INTEGER;
BEGIN
xlg2:=(xlg2+7) SHR 3;
k1:=ofs(pic); k2:=seg(pic);
memw(.k2:k1.):=xlg2; k1:=k1+2;
memw(.k2:k1.):=ylg2; k1:=k1+2;
FOR y:=y1 TO y1+ylg2 DO BEGIN
moveScr_tomem(x1,y,xlg2,k2,k1);
k1:=k1+xlg2;
END;
END;
PROCEDURE Scr_getTxt(VAR Txt; x1, y1, xlg2, ylg2: INTEGER);
VAR
adrseg, adrofs, j, y: INTEGER;
BEGIN
adrseg:=seg(Txt); adrofs:=ofs(Txt);
j:=(xlg2+1) SHL 1;
memw(.adrseg:adrofs.):=j; adrofs:=adrofs+2;
memw(.adrseg:adrofs.):=ylg2; adrofs:=adrofs+2;
FOR y:=y1 TO y1+ylg2 DO BEGIN
move(Txt_lineptr(.y.)^(.x1.),mem(.adrseg:adrofs.),j);
adrofs:=adrofs + j;
END;
END;
PROCEDURE Scr_putpic(VAR pic; x1, y1, xlg2, ylg2:INTEGER);
VAR
xlg, oldx, ylg: INTEGER;
y, k1, k2: INTEGER;
BEGIN
xlg2:=(xlg2+7) SHR 3;
k1:=ofs(pic); k2:=seg(pic);
xlg:=memw(.k2:k1.);k1:=k1+2;
ylg:=memw(.k2:k1.);k1:=k1+2;
IF ylg<ylg2 THEN ylg2:=ylg;
IF xlg<xlg2 THEN oldx:=xlg ELSE oldx:=xlg2;
FOR y:=y1 TO y1+ylg2 DO BEGIN
movememtoScr_(x1,y,oldx,k2,k1);
k1:=k1+xlg;
END;
END;
PROCEDURE Scr_putTxt(VAR Txt; x1, y1, xlg2, ylg2: INTEGER);
VAR
j, i, oldx, adrseg, adrofs, xlg, ylg: INTEGER;
BEGIN
adrseg:=seg(Txt); adrofs:=ofs(Txt);
j:=(xlg2+1) SHL 1;
xlg:=memw(.adrseg:adrofs.);adrofs:=adrofs+2;
ylg:=memw(.adrseg:adrofs.);adrofs:=adrofs+2;
IF ylg<ylg2 THEN ylg2:=ylg;
IF xlg<j THEN oldx:=xlg ELSE oldx:=j;
FOR i:=y1 TO y1+ylg2 DO BEGIN
move(mem(.adrseg:adrofs.),Txt_lineptr(.i.)^(.x1.),oldx);
adrofs:=adrofs+xlg;
END;
END;
PROCEDURE Scr_dump(mode:prn_Type);
VAR
printer: text;
i,j,k,k1,smax,tmax: INTEGER;
init_ch: STRING(.6.);
gr_str: STRING(.4.);
PROCEDURE prntchr(x,y,k: INTEGER);
VAR i: INTEGER;
BEGIN
FOR i:=1 TO k Do write(printer,chr(mem(.Scr_segm:Scr_yaddr(.y.)+Scr_xaddr(.x SHL 3.).)));
END;
BEGIN
assign(printer,'lpt1');
rewrite(printer);
IF ioresult<>0 THEN exit;
if graph_Type in (.IBM_High.) THEN k1:=2 ELSE k1:=1;
smax:=(Scr_maxy+1)*k1;
IF mode=IBM_graph THEN BEGIN
write(printer,chr(27)+'A'+chr(8),chr(27)+'2');
FOR i:=0 TO Txt_maxx DO BEGIN
write(printer,chr(27)+'K'+chr(lo(smax))+chr(hi(smax)));
FOR j:=0 TO Scr_maxy DO prntchr(i,j,k1);
writeln(printer);
END;
write(printer,chr(27)+'2');
END
ELSE
IF mode=RC_603 THEN BEGIN
writeln(printer,chr(27)+'T16'+chr(27)+'>'+chr(27)+'N');
str(smax:4,gr_str);
FOR i:=1 TO 4 DO IF gr_str(.i.)=' ' THEN gr_str(.i.):='0';
FOR i:=Txt_maxx DOWNTO 0 DO BEGIN
writeln(printer,chr(27)+'S'+gr_str);
FOR j:=Scr_maxy DOWNTO 0 DO prntchr(i,j,k1);
writeln(printer);
END;
writeln(printer,chr(27)+'c1');
END;
close(printer);
END;
PROCEDURE Wnd_WriteDot(x, y: INTEGER);
BEGIN
IF ((x >= 0) AND (x <= Wnd_MaxX)) AND ((y >= 0) AND (y <= Wnd_MaxY)) THEN
Scr_WriteDot(x + Wnd_X1, y + Wnd_Y1)
END;
FUNCTION Wnd_ReadDot(x, y : INTEGER) : BOOLEAN;
BEGIN
IF (x < 0) OR (x > Wnd_MaxX) OR (y < 0) OR (y > Wnd_MaxY) THEN
Wnd_ReadDot := false
ELSE Wnd_ReadDot := Scr_ReadDot(x + Wnd_X1,y + Wnd_Y1)
END;
FUNCTION convert(xx:REAL):INTEGER;
BEGIN
IF xx>maxint THEN convert:=maxint ELSE IF xx<-maxint THEN
convert:=-maxint ELSE convert:=trunc(xx);
END;
FUNCTION _GrOutcode(x1, y1, MaxX, MaxY: INTEGER): INTEGER;
VAR a: BYTE;
BEGIN
a:=0;
IF x1>maxx THEN a:=a OR $04;
IF x1<0 THEN a:=a OR $08;
IF y1>maxy THEN a:=a OR $01;
IF y1<0 THEN a:=a OR $02;
_GrOutcode:=a;
END;
FUNCTION _Wnd_ClipLine(VAR x1, y1, x2, y2 : INTEGER) : BOOLEAN;
VAR done : BOOLEAN;
outcode1, outcode2 : INTEGER;
BEGIN
done := FALSE;
_Wnd_ClipLine := FALSE;
outcode2 := _GrOutcode(x2, y2, Wnd_MaxX, Wnd_MaxY);
REPEAT
outcode1 := _GrOutcode(x1, y1, Wnd_MaxX, Wnd_MaxY);
IF (outcode1 OR outcode2) = 0 THEN BEGIN
_Wnd_ClipLine := TRUE;
exit END
ELSE IF (outcode1 AND outcode2) <> 0 THEN
BEGIN _Wnd_ClipLine := FALSE; exit
END ELSE BEGIN
IF outcode1 = 0 THEN BEGIN swapi(outcode1,outcode2);
swapi(x1, x2);
swapi(y1, y2)
END;
IF (outcode1 AND $01) <> 0 THEN BEGIN
x1 := x1 + convert((x2 - x1) * ((Wnd_MaxY - y1) / (y2 - y1)));
y1 := Wnd_MaxY
END ELSE IF (outcode1 AND $02) <> 0 THEN BEGIN
x1 := x1 + convert((x2 - x1) * ((0.0-y1) / (y2 - y1)));
y1 := 0
END ELSE IF (outcode1 AND $04) <> 0 THEN BEGIN
y1 := y1 + convert((y2 - y1) * ((Wnd_MaxX - x1) / (x2 - x1)));
x1 := Wnd_MaxX
END ELSE IF (outcode1 AND $08) <> 0 THEN BEGIN
y1 := y1 + convert((y2 - y1) *((0.0-x1) / (x2 - x1)));
x1 := 0
END
END
UNTIL done
END;
PROCEDURE Wnd_DrawLine(x1, y1, x2, y2: INTEGER);
BEGIN
IF _Wnd_ClipLine(x1, y1, x2, y2) THEN
Scr_DrawLine(x1 + Wnd_X1, y1 + Wnd_Y1, x2 + Wnd_X1,
y2 + Wnd_Y1);
END;
PROCEDURE Wnd_DrawBox(x1, y1, x2, y2 : INTEGER);
VAR DrawTop, DrawBot, DrawLeft, DrawRight : BOOLEAN;
BEGIN
DrawTop := TRUE;
DrawBot := TRUE;
DrawLeft := TRUE;
DrawRight := TRUE;
IF x1 < 0 THEN BEGIN
x1 := 0;
DrawLeft := FALSE
END;
IF y1 < 0 THEN BEGIN
y1 := 0;
DrawTop := FALSE
END;
IF x2 > Wnd_MaxX THEN BEGIN
x2 := Wnd_MaxX;
DrawRight := FALSE
END;
IF y2 > Wnd_MaxY THEN BEGIN
y2 := Wnd_MaxY;
DrawBot := FALSE
END;
x1 := x1 + Wnd_X1;
x2 := x2 + Wnd_X1;
y1 := (y1 + Wnd_Y1);
y2 := (y2 + Wnd_Y1);
IF DrawTop THEN Scr_DrawLine(x1, y1, x2, y1);
IF DrawRight THEN Scr_DrawLine(x2, y1, x2, y2);
IF DrawBot THEN Scr_DrawLine(x2, y2, x1, y2);
IF DrawLeft THEN Scr_DrawLine(x1, y2, x1, y1)
END;
PROCEDURE Wnd_Drawtext(x, y : INTEGER; c : str80);
BEGIN
Scr_textconvert(c,to_ibm);
IF (x < 0) or (x+7>Wnd_Maxx) THEN exit;
IF (x+7+(length(c) SHL 3)) > Wnd_MaxX THEN c:=copy(c,1,((Wnd_maxx-x+1) SHR 3));
IF (y<0) or ((y+7) > Wnd_MaxY) THEN exit;
Scr_WriteText(c,x + Wnd_X1 + 7, y + Wnd_Y1)
END;
PROCEDURE Wnd_circle(cx, cy, radius: INTEGER);
VAR
a, af, b, bf, target, r2: INTEGER;
BEGIN
target:=0; a:= radius; b:=0; r2:=sqr(radius);
WHILE a>=b DO BEGIN
b:=isqrt(r2 - sqr(a));
swapi(target, b);
WHILE b<target DO BEGIN
af:=Scr_aspect*a DIV 100; bf:=Scr_aspect*b DIV 100;
Wnd_WriteDot(cx+af,cy+b); Wnd_WriteDot(cx+bf,cy+a);
Wnd_WriteDot(cx-af,cy+b); Wnd_WriteDot(cx-bf,cy+a);
Wnd_WriteDot(cx-af,cy-b); Wnd_WriteDot(cx-bf,cy-a);
Wnd_WriteDot(cx+af,cy-b); Wnd_WriteDot(cx+bf,cy-a);
b:=b+1;
END;
a:=a-1;
END;
END;
FUNCTION _Wld_ToWindowX(x : REAL) : INTEGER;
BEGIN
_Wld_ToWindowX := convert(((x - Wld_X1) * Wnd_MaxX) / Wld_Xrange)
END;
FUNCTION _Wld_ToWindowY(y : REAL) : INTEGER;
BEGIN
_Wld_ToWindowY := convert(((y - Wld_Y1) * Wnd_MaxY) / Wld_YRange)
END;
(*Grafiske procedurer p▶86◀ brugerniveau*)
PROCEDURE fenceviewport(VAR v: Wnd_Id);
BEGIN
IF Wnd_actual<>NIL THEN
WITH Wnd_actual^ DO BEGIN
xold:=wld_xold;
yold:=wld_yold;
END;
move(v^.outer,Wnd_x1,sizeof(Wnd_type1));
move(v^.x1,wld_x1,115);
Wnd_actual:=v;
WITH v^.inner DO BEGIN
Wnd_x1:=Wnd_x1+x1;
Wnd_y1:=Wnd_y1+y1;
Wnd_maxx:=Wnd_maxx+maxx;
Wnd_maxy:=Wnd_maxy+maxy;
Wnd_Txtx1:=Wnd_Txtx1+Txtx1;
Wnd_Txty1:=Wnd_Txty1+Txty1;
Wnd_Txtmaxx:=Wnd_Txtmaxx+Txtmaxx;
Wnd_Txtmaxy:=Wnd_Txtmaxy+Txtmaxy;
END;
END;
PROCEDURE plot(x, y : REAL);
VAR x1, y1: INTEGER;
BEGIN
IF Txt_mode THEN error(4);
x1:=_Wld_ToWindowX(x); y1:=_Wld_ToWindowY(y);
Wnd_WriteDot(x1,y1 );
Wld_Xold:=x1; Wld_Yold:=y1;
END;
PROCEDURE circle(x,y,r: REAL);
BEGIN
IF Txt_mode THEN error(4);
Wnd_circle(_Wld_ToWindowX(x), _Wld_ToWindowY(y),_wld_towindowY(r));
END;
FUNCTION getcolor(x, y : REAL): BOOLEAN;
BEGIN
IF Txt_mode THEN error(4);
getcolor := Wnd_ReadDot(_Wld_ToWindowX(x), _Wld_ToWindowY(y))
END;
PROCEDURE moveto(x,y:REAL);
BEGIN
IF Txt_mode THEN error(4);
Wld_XOld:=_Wld_ToWindowX(x); Wld_YOld:=_Wld_ToWindowY(y);
END;
PROCEDURE Drawto(x2, y2 : REAL);
VAR
x1, y1: INTEGER;
BEGIN
IF Txt_mode THEN error(4);
x1:=_Wld_ToWindowX(x2); y1:= _Wld_ToWindowY(y2);
Wnd_DrawLine(Wld_XOld,Wld_YOld,x1,y1);
Wld_XOld:=x1; Wld_YOld:=y1;
END;
PROCEDURE DrawText(x, y: REAL; s: str80);
BEGIN
IF Txt_mode THEN error(4);
Wnd_DrawText(_Wld_ToWindowX(x), _Wld_ToWIndowY(y), s)
END;
PROCEDURE WriteText(col,row: INTEGER; s: str80);
VAR attrib: BYTE;
l : INTEGER;
BEGIN
if length(s)=0 then exit;
IF Txt_mode THEN BEGIN
Scr_textconvert(s,Txt_convert);
IF (col+length(s))>(Wnd_Txtmaxx+1) THEN s:=copy(s,1,Wnd_Txtmaxx+1-col);
IF row<=Wnd_Txtmaxy THEN
writestr(col+Wnd_Txtx1,row+Wnd_Txty1,s);
END
ELSE
Wnd_drawtext(col SHL 3,Wnd_maxy-7-(row SHL 3),s);
END;
PROCEDURE WriteReal(x,y:INTEGER; r:REAL; l,d: INTEGER);
VAR
s: str80;
BEGIN
str(r:l:d,s);
writetext(x,y,s);
END;
PROCEDURE DrawBox(x1, x2, y1, y2 : REAL);
BEGIN
IF Txt_mode THEN error(4);
Wnd_DrawBox(_Wld_ToWindowX(x1), _Wld_ToWindowY(y1),
_Wld_ToWindowX(x2), _Wld_ToWindowY(y2))
END;
PROCEDURE BoxWindow;
BEGIN
IF Txt_mode THEN error(4);
Wnd_DrawBox(0, 0, Wnd_MaxX, Wnd_MaxY);
END;
PROCEDURE drawheader;
VAR
i,oldcolor: INTEGER;
BEGIN
IF Wnd_hdr<>'' THEN BEGIN
i:=(Wnd_maxx SHR 3 - length(Wnd_hdr)) SHR 1;
IF i<0 THEN i:=0;
Scr_fillchar(Wnd_x1,Wnd_y1+Wnd_maxy-9, Wnd_maxx,Wnd_y1+Wnd_maxy,$FF);
oldcolor:=Wnd_pencolor;
Wnd_pencolor:=BLACK;
Wnd_drawbox(0,Wnd_maxy-9,Wnd_maxx,Wnd_maxy);
Wnd_maxy:=Wnd_maxy-1;
writetext(i,0,Wnd_hdr);
Wnd_pencolor:=oldcolor;
Wnd_maxy:=Wnd_maxy-9;
WITH Wnd_Actual^.inner DO maxy:=-11;
END;
END;
PROCEDURE drawframe;
BEGIN
IF Txt_mode THEN error(4);
fillchar(Wnd_Actual^.inner,sizeof(Wnd_type1),0);
fenceviewport(Wnd_actual);
drawheader;
Wnd_DrawBox(0, 0, Wnd_MaxX, Wnd_MaxY);
WITH Wnd_Actual^.inner DO BEGIN
x1:=1;
y1:=1;
maxy:=maxy-2;
maxx:=-2;
END;
fenceviewport(Wnd_actual);
END;
PROCEDURE gotoxy(x,y: INTEGER);
BEGIN
crt.gotoxy(x+Wnd_Txtx1 + 1,y+Wnd_Txty1 + 1);
END;
PROCEDURE clearviewport;
VAR i : INTEGER;
str: str80;
BEGIN
IF Txt_mode THEN BEGIN
str:=spc(Wnd_Txtmaxx+1,' ');
FOR i:=0 TO Wnd_Txtmaxy DO
writetext(0,i,str);
END
ELSE
Scr_fillchar(Wnd_x1, Wnd_y1, Wnd_MaxX, Wnd_y1 + Wnd_maxY ,lo(Wnd_backcolor));
END;
PROCEDURE writeframe;
VAR
i,lh,lx,ly: INTEGER;
s: str80;
BEGIN
fillchar(Wnd_Actual^.inner,sizeof(Wnd_type1),0);
fenceviewport(Wnd_actual);
lx:=Wnd_Txtmaxx; ly:=Wnd_Txtmaxy;
lh:=((lx+2)-length(Wnd_hdr)) SHR 1+1;
s:='▶c9◀'+spc(lx-1,'▶cd◀')+'▶bb◀';
move(Wnd_hdr(.1.),s(.lh.),length(Wnd_hdr));
WriteText(0,0,s);
FOR i:=1 TO ly-1 DO BEGIN WriteText(0,i,'▶ba◀');writeText(lx,i,'▶ba◀') END;
WriteText(0,ly,'▶c8◀'+spc(lx-1,'▶cd◀')+'▶bc◀');
WITH Wnd_Actual^.inner DO BEGIN
Txtx1:=1;Txtmaxx:=-2;
Txty1:=1;Txtmaxy:=-2;
x1:=8;maxx:=-16;
y1:=8;maxy:=-16;
END;
fenceviewport(Wnd_actual);
END;
PROCEDURE writehelp;
VAR
i,j,k,adrseg, adrofs: INTEGER;
str :str80;
strlgt:BYTE ABSOLUTE str;
BEGIN
writeframe;
IF Wnd_actual^.Txtinit=NIL THEN exit;
k:=0;
adrofs:=ofs(Wnd_actual^.Txtinit^);
adrseg:=seg(Wnd_actual^.Txtinit^);
FOR i:=0 TO Wnd_Txtmaxy DO BEGIN
strlgt:=mem(.adrseg:adrofs+k.);
FOR j:=1 TO strlgt DO
str(.j.):=CHAR(mem(.adrseg:adrofs+k+j.));
k:=k+Wnd_Txtmaxx+1;
WriteText(0,i,str);
END;
END;
(*Procedurer til h▶86◀ndtering af WINDOWS og VIEWPORTS*)
PROCEDURE chkviewportsize(x,y: INTEGER;VAR v: Wnd_Id);
BEGIN
WITH v^.outer DO BEGIN
IF x<0 THEN x1:=0 ELSE
IF ((x+maxx)>Scr_maxx) THEN x1:=Scr_maxx-maxx ELSE x1:=x;
IF y<0 THEN y1:=0 ELSE
IF ((y+maxy)>Scr_maxy) THEN y1:=Scr_maxy-maxy ELSE y1:=y;
x:=x SHR 3;
y:=(Scr_maxy-y-7) SHR 3;
IF x<0 THEN Txtx1:=0 ELSE
IF ((x+Txtmaxx)>Txt_maxx) THEN Txtx1:=Txt_maxx-Txtmaxx ELSE Txtx1:=x;
IF y<0 THEN Txty1:=0 ELSE
IF ((y+Txtmaxy)>Txt_maxy) THEN Txty1:=Txt_maxy-Txtmaxy ELSE Txty1:=y;
END;
END;
FUNCTION viewportBYTEs(VAR v: Wnd_Id): WORD;
VAR siz: WORD;
BEGIN
WITH v^.outer DO BEGIN
IF Txt_mode THEN
siz:= ((Txtmaxx+2) * (Txtmaxy+2) SHL 1) + 4
ELSE
siz:= ((maxx+7) SHR 3+1) * (maxy+1)+4;
END;
viewportbytes:=siz;
END;
PROCEDURE getcontent(VAR v: Wnd_id; siz: WORD);
begin
with v^ do begin
if content=nil then begin
if maxavail>siz then
getmem(content,siz)
else
error(8);
end else
if (bytes<>siz) then begin
freemem(content,bytes);
if maxavail>siz then
getmem(content,siz)
else
error(8);
end;
bytes:=siz;
end;
end;
PROCEDURE freecontent(VAR v: Wnd_ID);
begin
with v^ do begin
if content<>nil then freemem(content,bytes);
bytes:=0;
content:=nil;
end;
end;
PROCEDURE saveviewport(VAR v: Wnd_Id);
VAR siz: INTEGER;
BEGIN
IF v^.content=NIL THEN BEGIN
siz:=Viewportbytes(v);
getcontent(v,siz);
END;
WITH v^.outer DO
IF Txt_mode THEN
Scr_getTxt(v^.content^,Txtx1,Txty1,Txtmaxx,Txtmaxy)
ELSE
Scr_getpic(v^.content^, x1, y1, maxx, maxy);
END;
PROCEDURE Loadviewport(VAR v: Wnd_Id);
BEGIN
IF v^.content=NIL THEN exit;
WITH v^.outer DO
IF Txt_mode THEN
Scr_putTxt(v^.content^,Txtx1,Txty1,Txtmaxx,Txtmaxy)
ELSE
Scr_putpic(v^.content^,x1, y1, maxx, maxy);
END;
PROCEDURE swapviewport(VAR v: Wnd_Id);
VAR
dp: Buftype;
siz: INTEGER;
BEGIN
IF v^.content=NIL THEN BEGIN
saveviewport(v);
fenceviewport(v);
clearviewport;
exit;
END;
siz:=viewportbytes(v);
if maxavail>siz then
getmem(dp,siz)
else
error(8);
move(v^.content^,dp^,siz);
WITH v^.outer DO
IF Txt_mode THEN BEGIN
Scr_getTxt(v^.content^,Txtx1,Txty1,Txtmaxx,Txtmaxy);
Scr_putTxt(dp^,Txtx1,Txty1,Txtmaxx,Txtmaxy);
END ELSE BEGIN
Scr_getpic(v^.content^,x1,y1,maxx,maxy);
Scr_putpic(dp^,x1,y1,maxx, maxy);
END;
freemem(dp,siz);
END;
FUNCTION overlap (VAR a,b: Wnd_type1): BOOLEAN;
VAR
flag: BOOLEAN;
BEGIN
IF a.x1 < b.x1 THEN flag:=(a.maxx+a.x1) >= b.x1 ELSE
IF b.x1 < a.x1 THEN flag:=(b.maxx+b.x1) >= a.x1 ELSE flag:=TRUE;
IF flag THEN BEGIN
IF a.y1 < b.y1 THEN flag:=(a.maxy+a.y1)>= b.y1 ELSE
IF b.y1 < a.y1 THEN flag:=(b.maxy+b.y1)>= a.y1 ELSE flag:=TRUE;
END;
overlap:=flag;
END;
FUNCTION found_in_list(VAR l,w: Wnd_Id): BOOLEAN;
VAR v: Wnd_Id;
BEGIN
v:=l;
WHILE (v<>NIL) AND (v<>w) DO v:=v^.next;
found_in_list:=(v<>NIL);
END;
FUNCTION delete_from_list(VAR l, w: Wnd_Id; b: BOOLEAN): boolean;
VAR
u,v: Wnd_Id;
warr: ARRAY(.0..32.) OF Wnd_Id;
no,i: INTEGER;
BEGIN
u:=NIL;
v:=l;
no:=0;
WHILE (v<>NIL) AND (v<>w) DO BEGIN
IF b THEN IF overlap(w^.outer,v^.outer) THEN BEGIN
swapviewport(v);
warr(.no.):=v;
no:=no+1;
END;
u:=v; v:=v^.next;
END;
b:=(no>0);
IF b THEN BEGIN
warr(.no.):=w;
FOR i:=no DOWNTO 0 DO
swapviewport(warr(.i.));
END;
IF v<>NIL THEN BEGIN
IF u=NIL THEN l:=v^.next ELSE u^.next:=v^.next;
END;
w^.next:=NIL;
delete_from_list:=b;
END;
PROCEDURE selectviewport(VAR v: Wnd_Id);
VAR b: boolean;
BEGIN
IF v = NIL THEN error(3);
IF found_in_list(displaylist,v) THEN BEGIN
IF delete_from_list(displaylist,v,TRUE) THEN swapviewport(v);
fenceviewport(v);
END ELSE
IF found_in_list(hiddenlist,v) THEN BEGIN
b:=delete_from_list(hiddenlist,v,false);
b:=(v^.content=NIL);
swapviewport(v);
fenceviewport(v);
IF b THEN BEGIN
IF Wdrawframe in v^.art THEN drawframe;
IF Wwriteframe in v^.art THEN writeframe;
IF wtext in v^.art THEN writehelp;
END;
END ELSE BEGIN fenceviewport(WholeScreen); exit END;
v^.next:=displaylist;
displaylist:=v;
END;
PROCEDURE hideviewport(VAR v: Wnd_Id);
VAR b: boolean;
BEGIN
IF v = NIL THEN error(3);
IF found_in_list(displaylist,v) THEN BEGIN
IF NOT delete_from_list(displaylist,v,TRUE) THEN swapviewport(v);
IF (wnonhide in v^.art) THEN BEGIN
freecontent(v);
END;
v^.next:=hiddenlist;
hiddenlist:=v
END;
IF displaylist<>NIL THEN BEGIN
fenceviewport(displaylist);
END ELSE fenceviewport(WholeScreen);
END;
PROCEDURE closeviewport(VAR v: Wnd_Id);
VAR b: boolean;
BEGIN
IF v = NIL THEN exit;
Wnd_actual:=NIL;
IF found_in_list(displaylist,v) THEN BEGIN
IF NOT delete_from_list(displaylist,v,TRUE) THEN swapviewport(v);
END
ELSE IF found_in_list(hiddenlist,v) THEN
b:=delete_from_list(hiddenlist,v,false)
ELSE BEGIN
fenceviewport(displaylist); exit END;
freecontent(v);
freemem(v,sizeof(Wnd_Type));
IF displaylist<>NIL THEN BEGIN
fenceviewport(displaylist);
END ELSE fenceviewport(WholeScreen);
END;
PROCEDURE SetWindow(v: Wnd_Id; xx1, xx2, yy1, yy2 : REAL);
BEGIN
IF v = NIL THEN error(3);
WITH v^ DO BEGIN
X1 := xx1;
Y1 := yy1;
XRange := xx2 - xx1 ;
YRange := yy2 - yy1;
XOld:= 0;
YOld:= 0;
END;
END;
PROCEDURE setviewportcolor(VAR v: Wnd_Id; fcolor, bcolor: INTEGER);
BEGIN
IF v = NIL THEN error(3);
WITH v^ DO BEGIN
pencolor:=fcolor;
backcolor:=bcolor;
END;
END;
PROCEDURE setpalette(no, fcolor, bcolor: BYTE);
BEGIN
IF no in (.0..15.) THEN
Wnd_palette(.no.):=fcolor+(bcolor SHL 4);
END;
PROCEDURE settextviewportcolor(VAR v: Wnd_Id; no: BYTE);
BEGIN
IF v = NIL THEN error(3);
WITH v^ DO
paletteno:=no;
END;
PROCEDURE setviewportheader(VAR v: Wnd_Id; h: str80);
BEGIN
IF v = NIL THEN error(3);
v^.hdr:=h;
END;
PROCEDURE newviewport(VAR v: Wnd_Id; xx1, xx2, yy1, yy2: INTEGER);
BEGIN
IF (xx1>xx2) or (yy1>yy2) THEN error(7);
if maxavail> sizeof(Wnd_Type) then
getmem(v,sizeof(Wnd_Type))
else
error(8);
xx1 := xx1 AND $fff8;
xx2 := ((xx2+7) AND $fff8)-1;
IF xx1<0 THEN xx1:=0;
IF xx2>Scr_maxx THEN xx2:=Scr_maxx;
IF yy1<0 THEN yy1:=0;
IF yy2>Scr_maxy THEN yy2:=Scr_maxy;
WITH v^.outer DO BEGIN
x1 := xx1;
Y1 := yy1;
MaxX := xx2 - xx1 ;
MaxY := yy2 - yy1 ;
Txtx1:=xx1 SHR 3;
Txty1:=xx1 SHR 3;
Txtmaxx:=maxx SHR 3;
Txtmaxy:=maxy SHR 3;
END;
fillchar(v^.inner,sizeof(Wnd_type1),0);
WITH v^ DO BEGIN
content:=NIL;
art:=(..);
Txtinit:=NIL;
hdr:='';
x1:=0.0;
y1:=0.0;
xrange:=outer.maxx;
yrange:=outer.maxy;
xold:=0;
yold:=0;
pencolor:=WHITE;
backcolor:=BLACK;
paletteno:=0;
next:=hiddenlist;
bytes:=0;
END;
hiddenlist:=v;
END;
PROCEDURE newtextviewport(VAR v: Wnd_Id; xx1, xx2, yy1, yy2: INTEGER);
BEGIN
IF xx2>Txt_maxx THEN xx2:=Txt_maxx;
IF yy2>Txt_maxy THEN yy2:=Txt_maxy;
newviewport(v,xx1 SHL 3,xx2 SHL 3+7,Scr_maxy-((yy2 SHL 3)+7),Scr_maxy-(yy1 SHL 3));
WITH v^.outer DO BEGIN
Txtx1:=xx1;
Txty1:=yy1;
Txtmaxx:=xx2-xx1;
Txtmaxy:=yy2-yy1;
END;
END;
PROCEDURE newviewporttextmap(VAR v: Wnd_Id; x1, x2, y1, y2: INTEGER;VAR Txt);
BEGIN
newtextviewport(v,x1,x2+2,y1,y2+2);
v^.Txtinit:=addr(Txt);
v^.art:=(.wtext,wnonhide.);
END;
PROCEDURE setviewporttype(VAR v: Wnd_Id; vart: Wnd_art);
BEGIN
IF v = NIL THEN error(3);
v^.art:=vart;
END;
PROCEDURE GraphicScreen(typ :Scr_Type);
VAR
i: INTEGER;
BEGIN
init_graphics(typ);
Txt_mode:=TRUE;
graph_Type:=typ;
init_text;
FOR i:=0 TO 15 DO
setpalette(i,whiteTxt, blackTxt);
newviewport(WholeScreen,0,Scr_maxx,0,Scr_maxy);
WholeScreen^.next:=NIL;
displaylist:=NIL;
hiddenlist:=NIL;
newviewporttextmap(Wnd_help,Txt_maxx-42,Txt_maxx-2,0,7,help);
setpalette(2,blackTxt,yellowTxt);
settextviewportcolor(Wnd_help,2);
setviewportcolor(Wnd_help,BLACK,WHITE);
Wnd_actual:=NIL;
fenceviewport(WholeScreen);
END;
PROCEDURE moveviewport(x,y: INTEGER);
BEGIN
swapviewport(Wnd_actual);
chkviewportsize(x,y,Wnd_actual);
swapviewport(Wnd_actual);
fenceviewport(Wnd_actual);
END;
PROCEDURE movetextviewport(x,y: INTEGER);
BEGIN
moveviewport(x SHL 3,Scr_maxy-(y SHL 3 + Wnd_actual^.outer.maxy)+7);
END;
PROCEDURE newviewportbitmap(VAR v: Wnd_Id; x,y: INTEGER; name: str80;VAR err: BOOLEAN);
VAR
i,j,lgt,Bufptr: INTEGER;
BEGIN
Sys_openfile(name,Fil_Read,err);
IF err THEN exit;
Sys_readfile(13,bit_lgt);
newviewport(v,x,x+bit_xxlgt-7,y,y+bit_yylgt);
WITH v^ DO BEGIN
bit_xxlgt:=(bit_xxlgt+7) SHR 3;
j:=((outer.maxx+7) SHR 3+1) * (outer.maxy+1)+4;
getcontent(v,j);
fillchar(content^,j,0);
move(bit_xxlgt,content^,4);
Bufptr:=4;
WHILE (Bufptr<=j) DO BEGIN
Sys_readfile(1,bit_ellen);
IF bit_ellen=bit_selector THEN BEGIN
Sys_readfile(1,bit_ellen);
IF bit_ellen=0 THEN BEGIN
Sys_readfile(2,bit_xxlgt);
lgt:=bit_xxlgt;
END ELSE lgt:=bit_ellen;
Sys_readfile(1,bit_temp);
FOR i:=1 TO lgt DO BEGIN content^(.Bufptr.):=bit_temp; Bufptr:=Bufptr+1 END;
END
ELSE BEGIN
content^(.Bufptr.):=bit_ellen;
Bufptr:=Bufptr+1
END;
END;
Sys_closefile(Fil_Read);
END;
END;
PROCEDURE readchar;
BEGIN
char1:=NULL;
char2:=readkey;
IF char2=#0 THEN BEGIN
char1:=ESC;
char2:=readkey;
END ELSE
IF char2 in (.#0..#31.) THEN BEGIN
char1:=ESC;
CASE char2 OF
^S : char2:=Fleft ;
^D : char2:=Fright;
^V : char2:=Fins ;
^F : char2:=Fend ;
^A : char2:=Fhome ;
^G : char2:=Fdel ;
^E : char2:=Fup ;
^X : char2:=Fdown ;
^C : char2:=Fpgdn ;
^R : char2:=Fpgup ;
else
END;
END;
END;
PROCEDURE inputstr(VAR s: str80; term: Txt_charset;
VAR xx:INTEGER;x,y,l:INTEGER;VAR changed,inset: BOOLEAN);
VAR
oldcolor, xx1: INTEGER;
char3: CHAR;
PROCEDURE Scroll(xxx: INTEGER);
BEGIN
if (xx+xx1+xxx>length(s)) or ((xx1=0) and (xx+xxx<0)) then exit;
if (xx+xxx>Wnd_Txtmaxx) or (xx+xxx<0) then begin
xx1:=xx1+xxx;
writetext(x,y,copy(s,xx1+1,Wnd_Txtmaxx+1));
end else xx:=xx+xxx;
end;
BEGIN
xx1:=0;
writetext(x,y,s);
oldcolor:=Wnd_pencolor;
IF xx>length(s) THEN xx:=length(s);
REPEAT
IF NOT Txt_mode THEN BEGIN
IF xx+xx1+1>length(s) THEN char3:=' 'ELSE char3:=s(.xx+1+xx1.);
Wnd_pencolor:=Wnd_backcolor;
WriteText(x+xx,y,char3);
Wnd_pencolor:=oldcolor;
END ELSE begin gotoxy(x+xx,y);SetCursorOn; end;
readchar;
IF NOT Txt_mode THEN writetext(x+xx,y,char3);
IF char2 in term THEN BEGIN setcursoroff;exit; END;
IF char1=NULL THEN BEGIN
IF xx+xx1<=l THEN
BEGIN
changed:=TRUE;
IF xx+xx1+1>length(s) THEN s:=s+char2
ELSE BEGIN
IF inset THEN
insert(char2,s,xx+xx1+1)
ELSE
s(.xx+xx1+1.):=char2;
END;
WriteText(x+xx,y,copy(s,xx+xx1+1,Wnd_TxtMaxx+1));
Scroll(1);
END ELSE writeln(#7);
END ELSE
CASE char2 OF
f1: BEGIN
selectviewport(Wnd_help);
ReadChar;
hideviewport(Wnd_help);
END;
fleft: Scroll(-1);
fright: Scroll(+1);
fhome: IF xx=0 THEN Scroll(-xx1) else xx:=0;
fend:
BEGIN
IF xx=Wnd_TxtMaxx THEN Scroll(length(s)-xx1-Wnd_TxtMaxx);
if Wnd_Txtmaxx+xx1>=length(s) then xx:=length(s)-xx1 else xx:=Wnd_Txtmaxx;
END;
fdel:
IF (xx+xx1<=length(s)) AND (xx>=0) THEN
BEGIN
delete(s,xx+xx1+1,1);
writetext(x+xx,y,copy(s,xx+1+xx1,Wnd_TxtMaxx)+' ');
changed:=TRUE;
END;
fins: inset:= NOT inset;
^Y: BEGIN
delete(s,xx1+xx+1,length(s));
writetext(x+xx,y,spc(Wnd_TxtMaxx+1,BLANK));
changed:=TRUE;
END;
^H,#127:
IF xx>0 THEN
BEGIN
delete(s,xx+xx1,1);
writetext(x+xx-1,y,copy(s,xx+xx1,Wnd_TxtMaxx)+' ');
Scroll(-1);
changed:=TRUE;
END ELSE writeln(#7);
else
begin setcursoroff; exit end;
END;
UNTIL false;
END;
PROCEDURE drawaxis(xdens1,ydens1: REAL; gitter: boolean);
VAR
xx,xxx,xk0, yk0, xk1, yk1: INTEGER;
ekspox, ekspoy,j,i: INTEGER;
x,xdiff,xstart,xpix: REAL;
st: str80;
LABEL ud,ud2;
FUNCTION stringnumber(x1: REAL;ekspo : INTEGER): str80;
VAR s: str80;
BEGIN
str(x1*exp(-ekspo*ln(10.0)):5:2,s);
stringnumber:=s;
END;
FUNCTION GetExponent(X1:REAL):INTEGER;
BEGIN
GetExponent:=0;
IF X1<>0.0 THEN
IF abs(X1)>=1.0 THEN GetExponent:=trunc(ln(abs(X1))/ln(10.0))
ELSE GetExponent:=-trunc(abs(ln(abs(X1)))/ln(10.0)+1.0);
END;
PROCEDURE DrawExponent(x1,y1,MaxExponent:INTEGER;s: str80);
VAR i:INTEGER;
BEGIN
Wnd_drawtext(x1,y1,s);
i:=length(s);
str(MaxExponent,S);
Wnd_drawtext(x1+i*8, y1+2, S);
END;
PROCEDURE DrawNum(x1,y1,MaxExponent:INTEGER;Number:REAL);
VAR i:INTEGER;
StrNumber: str80;
BEGIN
StrNumber:=StringNumber(Number,MaxExponent);
Wnd_Drawtext(x1,y1,StrNumber);
END;
BEGIN
drawframe;
xk0:=6*8+2;
yk0:=12;
xk1:=Wnd_maxx;
yk1:=Wnd_maxy-8;
Wnd_drawline(xk0,yk0,xk0,yk1);
Wnd_drawline(xk0,yk0,xk1,yk0);
IF ydens1<=0.0 THEN GOTO ud2;
IF abs(Wld_yrange+wld_y1)>abs(Wld_Y1) THEN ekspoy:=getexponent(Wld_yrange+Wld_Y1)
ELSE ekspoy:=getexponent(Wld_Y1);
drawexponent(0,Wnd_maxy-10,ekspoy,'y*10');
IF ydens1>wld_yrange THEN BEGIN
xstart:=Wld_Y1;
xpix:=8.0; x:=0.0;
xdiff:=wld_yrange*(xpix/(Wnd_maxy-yk0));
END
ELSE BEGIN
xpix:=(Wnd_maxy-yk0)/(wld_yrange/ydens1);
x:=xpix*frac(Wld_Y1/ydens1);
xdiff:=wld_yrange*(xpix/(Wnd_maxy-yk0));
xstart:=xdiff*frac(Wld_Y1/ydens1)+Wld_Y1;
END;
x:=x+yk0;
xxx:=8;
WHILE x<Wnd_maxy DO BEGIN
xx:=round(x);
Wnd_DrawLine(xk0,xx,xk0-4,xx);
IF xxx>=8 THEN BEGIN
xxx:=0;
j:=xk0;
IF gitter THEN
WHILE j<=xk1 DO BEGIN
Wnd_writedot(j,xx); j:=j+3;
END;
IF xx<(Wnd_maxy-16)THEN BEGIN
DrawNum(0,xx,Ekspoy,xstart);
END;
END;
x:=xpix+x;
xxx:=round(xpix)+xxx;
xstart:=xstart+xdiff;
END;
ud2:
IF (xdens1<=0.0) THEN GOTO ud;
IF abs(Wld_xrange+Wld_X1)>abs(Wld_X1) THEN ekspox:=getexponent(Wld_xrange+Wld_X1)
ELSE ekspox:=getexponent(Wld_X1);
drawexponent(0,0,ekspox,'x*10');
IF xdens1>wld_xrange THEN BEGIN
xstart:=Wld_X1;
xpix:=48.0; x:=0.0;
xdiff:=wld_xrange*(xpix/(Wnd_maxx-xk0));
END
ELSE BEGIN
xpix:=(Wnd_maxx-xk0)/(wld_xrange/xdens1);
x:=xpix*frac(Wld_X1/xdens1);
xdiff:=wld_xrange*(xpix/(Wnd_maxx-xk0));
xstart:=xdiff*frac(Wld_X1/xdens1)+Wld_X1;
END;
x:=x+xk0;
xxx:=48;
WHILE x<Wnd_maxx DO BEGIN
xx:=round(x);
Wnd_DrawLine(xx,yk0,xx,yk0-4);
IF xxx>=48 THEN BEGIN
xxx:=0;
j:=yk0;
IF gitter THEN
WHILE j<=yk1 DO BEGIN
Wnd_writedot(xx,j); j:=j+3;
END;
IF x>(xk0+48) THEN BEGIN
Wnd_DrawLine(xx-1,yk0,xx-1,yk0-4);
DrawNum(xx-40,0,Ekspox,xstart);
END;
END;
x:=xpix+x;
xxx:=round(xpix)+xxx;
xstart:=xstart+xdiff;
END;
ud:
WITH Wnd_actual^.inner DO BEGIN
x1:=x1+xk0;
maxx:=maxx-xk0;
y1:=y1+yk0+1;
maxy:=maxy-yk0-1;
END;
fenceviewport(Wnd_actual);
moveto(Wld_X1,0.0); drawto(wld_xrange,0.0);
moveto(0.0,Wld_Y1); drawto(0.0,wld_yrange);
END;
begin
scr_pattern:=$0000;
ExitSave:=Exitproc;
ExitProc:=@ErrorProc;
end.«eof»