DataMuseum.dk

top - download

    Length: 6272 (0x1880)
    Types: TextFile
    Names: »JET80F.PAS«

└─⟦6cf793dfc⟧ Bits:30003506 JET80 Grafik og fontprogrammering
    └─ ⟦this⟧ »JET80F.PAS« 

TextFile

(*Procedurpaket før Jet80F*)

TYPE     str                 = String(.80.);

VAR      gargs               : RECORD
                                 opcode : Byte;
                                 arg0   : Byte;
                                 arg1   : Integer;
                                 arg2   : Integer;
                                 arg3   : Integer;
                                 arg4   : Integer;
                                 arg5   : Integer;
                               END;


PROCEDURE init;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=1;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE blank;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=2;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE displ;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=3;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE selchr(VAR adr:Integer);
VAR      a                   : Integer;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=4;
    arg0:=1;
    arg1:=Addr(adr);
  END;
  a:=BdosHL(60,Addr(gargs));
  adr:=Swap(Mem(.a+1.))+Mem(.a.);
END;


PROCEDURE empty;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=5;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE zoomup;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=6;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE zoomdn;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=7;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE zoomdf(n:Byte);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=8;
    arg0:=1;
    arg1:=Addr(n);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE scrup;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=9;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE scrdn;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=10;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE panr;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=11;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE panl;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=12;
    arg0:=0;
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE move(x,y:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=13;
    arg0:=2;
    arg1:=Addr(x);
    arg2:=Addr(y);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE draw(x,y:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=14;
    arg0:=2;
    arg1:=Addr(x);
    arg2:=Addr(y);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE octant(r,o,theta,phi:Integer);FORWARD;

PROCEDURE circle(x,y,r:Integer);
VAR      i                   : Byte;
BEGIN
  move(x,y);
  FOR i:=0 TO 7 DO
    octant(r,i,45,0);
(*
  WITH gargs DO
  BEGIN
    opcode:=15;
    arg0:=3;
    arg1:=Addr(x);
    arg2:=Addr(y);
    arg3:=Addr(r);
  END;
  Bdos(60,Addr(gargs));
*)
END;


PROCEDURE drline(x1,x2,y1,y2:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=16;
    arg0:= 5;
    arg1:=Addr(x1);
    arg2:=Addr(x2);
    arg3:=Addr(y1);
    arg4:=Addr(y2);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE rect(x,y,h,b,dir:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=17;
    arg0:=5;
    arg1:=Addr(x);
    arg2:=Addr(y);
    arg3:=Addr(h);
    arg4:=Addr(b);
    arg5:=Addr(dir);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE char(n:Integer;dir:Byte);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=18;
    arg0:=2;
    arg1:=Addr(n);
    arg2:=Addr(dir);
  END;
  Bdos(60,Addr(gargs));
END;



PROCEDURE strng(text:str;dir:Byte);
VAR      byt_arr       : Array(.1..3.) OF Byte;
BEGIN
  byt_arr(.1.):=Length(text);
  byt_arr(.2.):=Lo(Addr(text)+1);
  byt_arr(.3.):=Hi(Addr(text)+1);
  WITH gargs DO
  BEGIN
    opcode:=19;
    arg0:=2;
    arg1:=Addr(byt_arr);
    arg2:=Addr(dir);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE drawpa(p:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=20;
    arg0:=1;
    arg1:=Addr(p);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE moddef(m:Byte);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=21;
    arg0:=1;
    arg1:=Addr(m);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE sizedef(s:Byte);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=22;
    arg0:=1;
    arg1:=Addr(s);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE fillpa(pa:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=23;
    arg0:=1;
    arg1:=Addr(pa);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE fill(x,y,h,b,dir:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=24;
    arg0:=5;
    arg1:=Addr(x);
    arg2:=Addr(y);
    arg3:=Addr(h);
    arg4:=Addr(b);
    arg5:=Addr(dir);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE setcol(f:Byte);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=25;
    arg0:=1;
    arg1:=Addr(f);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE polyln(adress:Integer);    (* vektor som parameter istællet ? *)
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=26;
    arg0:=1;
    arg1:=adress;
  END;
  Bdos(60,Addr(gargs));
END;

PROCEDURE octant;                    (*(r,o,theta,phi:Integer)*)
VAR      t,p                 : Integer;
BEGIN
  p:=Round(r*Sin(phi*pi/180));
  t:=Round(r*Sin(theta*pi/180));
  WITH gargs DO
  BEGIN
    opcode:=27;
    arg0:=4;
    arg1:=Addr(r);
    arg2:=Addr(o);
    arg3:=Addr(t);
    arg4:=Addr(p);
  END;
  Bdos(60,Addr(gargs));
END;

PROCEDURE where(VAR x,y:Integer);
VAR      a                   : Integer;
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=28;
    arg0:=0;
  END;
  a:=BdosHL(60,Addr(gargs));
  x:=Swap(Mem(.a.))+Mem(.a-1.);
  y:=Swap(Mem(.a-2.))+Mem(.a-3.);
END;


PROCEDURE origo(x,y:Integer);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=29;
    arg0:=2;
    arg1:=Addr(x);
    arg2:=Addr(y);
  END;
  Bdos(60,Addr(gargs));
END;


PROCEDURE backgr(farg:Byte);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=30;
    arg0:=1;
    arg1:=Addr(farg);
  END;
  Bdos(60,Addr(gargs));
END;

PROCEDURE chrtyp(t:Byte);
BEGIN
  WITH gargs DO
  BEGIN
    opcode:=31;
    arg0:=1;
    arg1:=Addr(t);
  END;
  Bdos(60,Addr(gargs));
END;

«eof»