|
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: 9229 (0x240d)
Types: TextFile
Names: »CPIFONT.PAS«
└─⟦d4ddf50a0⟧ Bits:30004478 CPI-graf 2.5 til Piccoline/Partner
└─⟦this⟧ »CPIFONT.PAS«
æ$A+,B-,D+,E-,F-,I-,L-,N-,O-,R-,S-,V-å
UNIT cpifont;
(*------------------------------------------------------------------------*)
(* CPI-font 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. *)
(* *)
(*------------------------------------------------------------------------*)
interface
uses cpigraf;
CONST
fnt_max = 10;
masks : ARRAY(.0..7.) OF BYTE =
(0,$80,$C0,$E0,$F0,$F8,$FC,$FE);
TYPE
fnt_buftype1 = ARRAY (.0..$7fff.) OF BYTE;
fnt_buftype = ^fnt_buftype1;
fnt_TYPE = RECORD
flgt : INTEGER;
cto, cfrom : BYTE;
xlgt, ylgt, tot : BYTE;
buf : fnt_buftype;
END;
VAR
fnt_arr : ARRAY(.0..fnt_max.) OF fnt_TYPE;
fnt_TO,fnt_from : BYTE;
fnt_xlgt, fnt_ylgt, fnt_totlgt: BYTE;
fnt_buf : fnt_buftype;
fnt_xbytes : BYTE;
fnt_ptr : ARRAY(.0..255.) OF integer;
fnt_actual : INTEGER;
fnt_convert : txt_converttype;
fnt_segm : integer;
PROCEDURE selectfont(no: INTEGER);
PROCEDURE drawfont(x,y: REAL;s: str80);
PROCEDURE writefont(x,y: INTEGER;s: str80);
PROCEDURE readfont(fntno: INTEGER; name: str80; VAR err: boolean);
PROCEDURE closefont(no: INTEGER);
PROCEDURE initfont;
PROCEDURE scr_drawblock(x,y: INTEGER; adr: integer);
implementation
PROCEDURE scr_drawblock(x,y: INTEGER; adr: integer);
VAR
mask1, mask2 : BYTE;
BEGIN
Inline(
$BA/$08/$00/ æ MOV DX,$0008å
$8B/$76/<X/ æ MOV SI,ÆBP+<XÅå
$81/$E6/$07/$00/ æ AND SI,$0007å
$29/$F2/ æ SUB DX,SIå
$B5/<TRANSP/ æ MOV CH,<TRANSPå
$3A/$2E/>WND_PENCOLOR/ æ CMP CH,Æ>WND_PENCOLORÅå
$75/$0B/ æ JNZ X31å
$C6/$46/<MASK2/$FF/ æ MOV BYTE PTR ÆBP+<MASK2Å,-$01å
$C6/$46/<MASK1/$00/ æ MOV BYTE PTR ÆBP+<MASK1Å,+$00å
$E9/$0C/$00/ æ JMP NEAR X44å
æX31:å
$8A/$9C/>MASKS/ æ MOV BL,ÆSI+>MASKSÅå
$88/$5E/<MASK1/ æ MOV ÆBP+<MASK1Å,BLå
$F6/$D3/ æ NOT BLå
$88/$5E/<MASK2/ æ MOV ÆBP+<MASK2Å,BLå
$31/$C0/ æX44: XOR AX,AXå
$A0/>FNT_YLGT/ æ MOV AL,Æ>FNT_YLGTÅå
$50/ æ PUSH AXå
$48/ æ DEC AXå
$03/$46/<Y/ æ ADD AX,ÆBP+<YÅå
$8E/$06/>SCR_SEGM/ æ MOV ES,Æ>SCR_SEGMÅå
$89/$C6/ æ MOV SI,AXå
$D1/$E6/ æ SHL SI,1å
$59/ æ POP CXå
$51/ æX63: PUSH CXå
$8B/$7E/<X/ æ MOV DI,ÆBP+<XÅå
$D1/$E7/ æ SHL DI,1å
$8B/$9C/>SCR_YADDR/ æ MOV BX,ÆSI+>SCR_YADDRÅå
$03/$9D/>SCR_XADDR/ æ ADD BX,ÆDI+>SCR_XADDRÅå
$26/ æ ES:å
$8A/$37/ æ MOV DH,ÆBXÅå
$22/$76/<MASK1/ æ AND DH,ÆBP+<MASK1Åå
$31/$C9/ æ XOR CX,CXå
$8A/$0E/>FNT_XBYTES/ æ MOV CL,Æ>FNT_XBYTESÅå
$51/ æX89: PUSH CXå
$57/ æ PUSH DIå
$1E/ æ PUSH DSå
$8E/$1E/>FNT_SEGM/ æ MOV DS,Æ>FNT_SEGMÅå
$8B/$7E/<ADR/ æ MOV DI,ÆBP+<ADRÅå
$31/$C0/ æ XOR AX,AXå
$8A/$05/ æ MOV AL,ÆDIÅå
$1F/ æ POP DSå
$88/$D1/ æ MOV CL,DLå
$8A/$2E/>WND_PENCOLOR/ æ MOV CH,Æ>WND_PENCOLORÅå
$80/$FD/<WHITE/ æ CMP CH,<WHITEå
$75/$0A/ æ JNZ X125å
$D3/$E0/ æ SHL AX,CLå
$08/$F4/ æ OR AH,DHå
$26/ æ ES:å
$88/$27/ æ MOV ÆBXÅ,AHå
$E9/$18/$00/ æ JMP NEAR X149å
$80/$FD/<BLACK/ æX125: CMP CH,<BLACKå
$75/$0C/ æ JNZ X142å
$F6/$D0/ æ NOT ALå
$D3/$E0/ æ SHL AX,CLå
$08/$F4/ æ OR AH,DHå
$26/ æ ES:å
$88/$27/ æ MOV ÆBXÅ,AHå
$E9/$07/$00/ æ JMP NEAR X149å
$D3/$E0/ æX142: SHL AX,CLå
$08/$F4/ æ OR AH,DHå
$26/ æ ES:å
$30/$27/ æ XOR ÆBXÅ,AHå
$88/$C6/ æX149: MOV DH,ALå
$5F/ æ POP DIå
$FF/$46/<ADR/ æ INC WORD PTR ÆBP+<ADRÅå
$81/$C7/$10/$00/ æ ADD DI,$0010å
$8B/$9C/>SCR_YADDR/ æ MOV BX,ÆSI+>SCR_YADDRÅå
$03/$9D/>SCR_XADDR/ æ ADD BX,ÆDI+>SCR_XADDRÅå
$59/ æ POP CXå
$E2/$AF/ æ LOOP X89å
$26/ æ ES:å
$8A/$27/ æ MOV AH,ÆBXÅå
$22/$66/<MASK2/ æ AND AH,ÆBP+<MASK2Åå
$30/$F4/ æ XOR AH,DHå
$26/ æ ES:å
$88/$27/ æ MOV ÆBXÅ,AHå
$4E/ æ DEC SIå
$4E/ æ DEC SIå
$59/ æ POP CXå
$E2/$85); æ LOOP X63å
END;
PROCEDURE selectfont(no: INTEGER);
VAR
b : BYTE;
i,n : INTEGER;
BEGIN
WITH fnt_arr(.no.) DO BEGIN
IF buf=NIL THEN error(6);
move(cto,fnt_TO,9);
END;
fnt_xbytes:=((fnt_xlgt+7) SHR 3);
fnt_segm:=seg(fnt_buf^);
FOR i:=0 TO 255 DO BEGIN
IF (i>=fnt_from) AND (i<=fnt_TO) THEN n:=i ELSE n:=32;
fnt_ptr(.i.):=ofs(fnt_buf^(.(n-fnt_from)*fnt_totlgt.))
END;
IF no=0 THEN fnt_convert:=to_ibm ELSE fnt_convert:=to_iso;
fnt_actual:=no;
END;
PROCEDURE closefont(no: INTEGER);
BEGIN
WITH fnt_arr(.no.) DO BEGIN
freemem(buf,flgt);
flgt:=0;
END;
END;
PROCEDURE readfont(fntno: INTEGER; name: str80; VAR err: boolean);
VAR
i,j : INTEGER;
BEGIN
sys_openfile(name,fil_read,err);
IF err THEN exit;
WITH fnt_arr(.fntno.) DO BEGIN
sys_readfile(7,flgt);
if maxavail>flgt then
getmem(buf,flgt)
else error(9);
sys_readfile(flgt-7,buf^);
cto:=cto+cfrom;
END;
sys_closefile(fil_read);
END;
PROCEDURE initfont;
VAR
i : INTEGER;
BEGIN
WITH fnt_arr(.0.) DO BEGIN
xlgt:=sys_xlgt; ylgt:=sys_ylgt; cfrom:=sys_from; cto:=sys_TO; tot:=sys_totlgt;
buf:=addr(scr_CHAR);
END;
FOR i:=1 TO fnt_max DO
WITH fnt_arr(.i.) DO BEGIN
buf:=NIL;
fillchar(flgt,7,0);
END;
selectfont(0);
END;
PROCEDURE wnd_drawfont(x,y: INTEGER;VAR s: str80);
VAR
i,x2 : INTEGER;
BEGIN
scr_textconvert(s,fnt_convert);
IF (y<0) OR ((y+fnt_ylgt-1)>wnd_maxy) THEN exit;
if (x<0) OR (x+fnt_xlgt-1>Wnd_Maxx) THEN exit;
x2:=length(s);
if (x+(length(s)+1)*fnt_xlgt)>wnd_maxx then x2:=(Wnd_maxx-x)div fnt_xlgt;
x:=x+wnd_x1;
y:=y+wnd_y1;
FOR i:=1 TO x2 DO BEGIN
scr_drawblock(x,y,fnt_ptr(.BYTE(s(.i.)).));
x:=x+fnt_xlgt;
END;
END;
PROCEDURE drawfont(x,y: REAL;s: str80);
BEGIN
wnd_drawfont(_wld_towindowx(x),_wld_towindowy(y),s);
END;
PROCEDURE writefont(x,y: INTEGER;s: str80);
BEGIN
wnd_drawfont(x * (fnt_xlgt),wnd_maxy-fnt_ylgt-(y*(fnt_ylgt)),s);
END;
end.
«eof»