|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 23168 (0x5a80)
Types: TextFile
Names: »PASGRAF.PAS«
└─⟦443ac2dce⟧ Bits:30004209 Juletilbud 1985 fra ICL A/S til ICL Comet (2x80 spor)
└─ ⟦this⟧ »PASGRAF.PAS«
program TESTGRAF; (* Version 1.0 - 1985.08.16 / ULJ *)
(*>>>>>>>>> Copyright (c) 1985, ICL A/S - Ulrich Lysdal Jensen <<<<<<<<<<*)
Var
hkar: char;
i: integer;
(**********************-- PASGRAF --***************************************
>>>>>>>>>>> Copyright (c) 1985, ICL A/S - Ulrich Lysdal Jensen <<<<<<<<<<<<
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!! !!!!!!!!!!!
!!!!!!!!!! ICL A/S PÅTAGER SIG IKKE NOGET ANSVAR FOR !!!!!!!!!!!
!!!!!!!!!! EVENTUELLE FEJL ELLER MANGLER I DETTE PROGRAMMEL. !!!!!!!!!!!
!!!!!!!!!! !!!!!!!!!!!
!!!!!!!!!! PROGRAMMELLET MÅ KUN MED ICL's SKRIFTLIGE !!!!!!!!!!!
!!!!!!!!!! GODKENDELSE ANVENDES I KOMMERCIELT ØJEMED. !!!!!!!!!!!
!!!!!!!!!! !!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
###########################################################################
Disse PASCAL-procedurer udfører de grundlæggende grafiske operationer:
Status Undersøger om grafikprocessoren er klar til
en ny kommando.
GrafBillede1: Skifter til grafikbillede nr. 1.
GrafBillede2: Skifter til grafikbillede nr. 2.
VideoBillede: Skifter til videobilledet.
GrafInit: Initierer for grafik - se spec. i proceduren.
SletBillede: Sletter det viste grafikbillede.
PenNed: Sætter pen til tegning.
PenOp: Sætter pen til ikke tegne.
EraseNed: Sætter pen til sletning (viskelæder).
EraseOp: Sætter pen til ikke sletning (samme effekt som
PenOp ved flytning af pennen).
KarSize(ch,cy): Sætter karakterstørrelse - se spec. i proc.
LinieType(l): Sætter linietype for tegning - se spec. i proc.
KarType(k): Sætter karaktertype ved tekst - se spec. i proc.
MovePen(x,y): Flytter pennen fra nuværende position til (x,y).
Der tegnes/slettes i overensstemmelse med gældende
pen/eraser op/ned.
MoveTo(x,y): Flytter pennen uden tegning til (x,y).
DrawTo(x,y): Tegner linie fra nuværende position til (x,y).
EraseTo(x,y): Sletter linie fra nuværende position til (x,y).
PrikOn(x,y): Tænder en pixel i (x,y).
PrikOff(x,y): Slukker en pixel i (x,y).
Cirkel(x,y,r): Tegner cirkel m. centrum (x,y) og radius r.
Tekst(x,y,cx,cy,strg): Skriver teksten strg startende i (x,y)
med karakterstørrelsen cx,cy.
Grafikskærmens dimensioner er 512 x 512 pixels, der adresseres i et
koordinatsæt med (0,0) i skærmens nederste venstre hjørne, dvs.
x og y ligger i intervallet 0 til 511.
BEMÆRK: Med rutinerne MovePen, MoveTo, DrawTo og EraseTo må der højest
tegnes/flyttes eller slettes over afstande, der svarer til en til-
vækst i X- og/el. Y-retningen på max. 510 pixels.
Denne fil - PASGRAF.PAS - kan anvendes som include-fil i et PASCAL-program.
I den aktuelle anvendelse kan visse procedurer evt. udelades, men brugeren
må være opmærksom på, at de enkelte procedurer kalder hinanden indbyrdes,
hvorfor kriteriet for sletning IKKE alene er, at proceduren ikke forekommer
i brugerens programdel.
Et eksempel på anvendelse af disse procedurer findes i programmet TESTGRAF.
Lyngby, den 16. august 1985 / Ulrich Lysdal Jensen.
##########################################################################*)
TYPE
streng = string(.80.); (* Anvendes i Tekst *)
procedure Status; (*********************************************)
(* Checker om grafikprocessor klar til ny kommando *)
begin
while port(.160.) AND $F4 = 0 do;
end;
procedure GrafBillede1; (*********************************************)
(* Vælger grafikbillede nr. 1 *)
begin
port(.176.) := 255;
port(.179.) := 0;
end;
procedure GrafBillede2; (*********************************************)
(* Vælger grafikbillede nr. 2 *)
begin
port(.176.) := 255;
port(.179.) := 255;
end;
procedure VideoBillede; (***********************************************)
(* Vælger videobilledet *)
begin
port(.176.) := 0;
end;
procedure GrafInit; (***********************************************)
(* Initiering af grafikmodul:
- Billede 1 og 2 blankstilles
- X-reg = Y-reg. = DX-reg. = DY-reg. = 0
- Pen DOWN
- CHX = CHY = 1
- Kontinuert linietype
- Lodret skrift på vandret linie
- RMW OFF
Efter udførelse af GrafInit vises grafikbillede nr. 1*)
begin
GrafBillede2;
port(.160.) := 7;
GrafBillede1;
port(.160.) := 7;
port(.177.) := 0;
end;
procedure SletBillede; (****************************************)
(* Sletter det viste grafikbillede *)
begin
port(.160.) := 7;
end;
procedure PenNed; (***************************************)
(* Sætter Pen DOWN - skrive *)
begin
port(.160.) := 0;
port(.160.) := 2;
end;
procedure PenOp; (**************************************)
(* Sætter Pen UP - flytte uden skrive *)
begin
port(.160.) := 0;
port(.160.) := 3;
end;
procedure EraseNed; (**************************************)
(* Sætter Eraser DOWN - sletter *)
begin
port(.160.) := 1;
port(.160.) := 2;
end;
procedure EraseOp; (**************************************)
(* Sætter Eraser UP - flytte uden slette *)
begin
port(.160.) := 1;
port(.160.) := 2;
end;
procedure KarSize(x,y: integer); (***************************************)
(* Sætter karakterstørrelsen CHX = x og CHY = y
x/y = <1...16> (1 = mindste karakterstørrelse).
Hvis x og/el. y > 16 sættes værdien til 16.
BEMÆRK: intervallet for x og y er forskellig fra det for grafikmodulet
specificerede. *)
begin
if x>=16 then x:=0;
if y>=16 then y:=0;
port(.163.) := x*16+y;
end;
procedure LinieType(l: integer); (***************************************)
(* Sætter linietype til l: 0 => kontinuert linietype ______
1 => punkteret linietype ......
2 => stiplet linietype ------
3 => stiplet/punkteret linietype _._._.
Hvis l > 3 sættet kontinuert linietype *)
begin
if l > 3 then l:=0;
port(.162.) := (port(.162.) AND $FC) + l;
end;
procedure KarType(k: integer); (**************************************)
(* Sætter karaktrtype til k: 0 => lodret skrift på vandret linie
1 => skrå skrift på vandret linie
2 => lodret skrift på lodret linie
3 => skrå skrift på lodret linie
Hvis k > 3 sættes lodret skrift på vandret linie *)
begin
if k > 3 then k:=0;
port(.162.) := (port(.162.) AND $F3) + k*4;
end;
procedure MovePen(x,y: integer); (*************************************)
(* Bevæger pen/eraser fra nuværende koordinater (X-reg,Y-reg) til (x,y)
Under flytningen tegnes/slettes i overensstemmelse med valget af
pen/eraser op/ned.
Der kan maksimalt flyttes en afstand svarende til en tilvækst i
X- og/el. Y-retningen på 510 pixels. *)
Var
i,kommando,mx,my,mdx,mdy: integer;
begin
mx := port(.168.)*256 + port(.169.);
my := port(.170.)*256 + port(.171.);
mdx := x - mx;
mdy := y - my;
port(.165.) := ABS(mdx) DIV 2;
port(.167.) := ABS(mdy) DIV 2;
if mdx>0 then
if mdy>0 then
kommando := 17
else
kommando := 21
else
if mdy>0 then
kommando := 19
else
kommando := 23;
port(.160.) := kommando;
Status;
port(.165.) := ABS(mdx) - port(.165.);
port(.167.) := Abs(mdy) - port(.167.);
port(.160.) := kommando;
end;
procedure MoveTo(x,y: integer); (*************************************)
(* Flytter pen oppe (ikke skrive) til (x,y).
Tilvæksten i X- og/el. Y-retningen må højest være 510 pixels. *)
begin
PenOp;
MovePen(x,y);
end;
procedure DrawTo(x,y: integer); (************************************)
(* Tegner ret linie fra gældende koordinater (X-reg,Y-reg) til (x,y).
Tilvæksten i X- og/el. Y-retningen må højest være 510 pixels.
Den rette linie tegnes med gældende linietype - se LinieType. *)
begin
PenNed;
MovePen(x,y);
end;
procedure EraseTo(x,y: integer); (*************************************)
(* Sletter en ret linie fra gældende koord. (X-reg,Y-reg) til (x,y).
Tilvæksten i X- og/el. Y-retningen mø højest være 510 pixels. *)
begin
EraseNed;
MovePen(x,y);
end;
procedure PrikOn(x,y: integer); (*************************************)
(* Sætter prikken i (x,y) lysende *)
begin
MoveTo(x,y);
PenNed;
port(.160.) := 128;
end;
procedure PrikOff(x,y: integer); (*************************************)
(* Slukker prikken i (x,y) *)
begin
MoveTo(x,y);
EraseNed;
port(.160.) := 128;
end;
procedure Cirkel(x,y,r: integer); (*************************************)
(* Tegner cirkel med centrum i (x,y) og radius r.
Linietypen er altid kontinuert. *)
Var
cx,cy,s: integer;
begin
cx := r;
cy := 0;
s := r - 2*cx;
while cx >= cy do
begin
PrikOn(x+cx,y+cy);
PrikOn(x+cy,y+cx);
PrikOn(x-cy,y+cx);
PrikOn(x-cx,y+cy);
PrikOn(x-cx,y-cy);
PrikOn(x-cy,y-cx);
PrikOn(x+cy,y-cx);
PrikOn(x+cx,y-cy);
s := s + 2*cy + 1;
cy := cy + 1;
if s >= 0 then
begin
s := s - 2*cx + 2;
cx := cx - 1;
end;
end;
end;
procedure Tekst(x,y,cx,cy: integer; strg: streng); (*******************)
(* Skriver en tekst indeholdt i strg, startende i (x,y).
karakterstørrelse er bestemt af cx,cy.
karaktertypen er den gældende - se KarType. *)
Var
ti: integer;
begin
MoveTo(x,y);
PenNed;
KarSize(cx,cy);
for ti:=1 to len(strg) do
begin
port(.160.) := ord(strg(.ti.));
Status;
end;
end;
(***********************-- Slut PASGRAF --*********************************)
(* ----------- Nogle procedurer lavet med PASGRAF-procedurerne ----------- *)
procedure Rektangel(x1,y1,x2,y2: integer);
(* Eksempel på sammenstilling af PASGRAF procedurer til tegning af
en figur - her et rektangel med sider parallelle med koordinat-
akserne og to diamentralt modsatte hjørnepunkter (x1,y1) og (x2,y2) *)
begin
MoveTo(x1,y1);
DrawTo(x2,y1);
DrawTo(x2,y2);
DrawTo(x1,y2);
DrawTo(x1,y1);
end;
procedure Rhombe(xb,yb,xt,yt: integer);
(* Tegner rhombe med øverste hjørnepunkt (xt,yt) og nederste hjørnepunkt
(xb,yb) *)
Var
hjy: integer;
begin
MoveTo(xt,yt);
hjy := (yt - yb) DIV 2;
DrawTo(xb-hjy,yb+hjy);
DrawTo(xb,yb);
Drawto(xb+hjy,yb+hjy);
DrawTo(xt,yt);
end;
procedure Slette(x1,y1,x2,y2: integer);
(* Sletter et rektangulært område af skærmen. Rektanglet er bestemt af
de to diamentralt modsatte hjørner (x1,y1) og (x2,Y2) *)
Var
si: integer;
begin
for si := 0 to ABS(y2-y1) do
begin
MoveTo(x1,y1+si);
EraseTo(x2,y1+si);
end;
end;
(***************************** HOVEDPROGRAM ********************************)
begin
GrafInit;
Rektangel(0,0,500,500);
for i:=1 to 150 do Rhombe(250,250+i,250,250-i);
MoveTo(0,250);
DrawTo(100,250);
MoveTo(250,500);
DrawTo(250,400);
MoveTo(500,250);
DrawTo(400,250);
Moveto(250,0);
DrawTo(250,100);
Slette(200,200,300,300);
Tekst(210,242,2,2,'PASGRAF');
for i:=1 to 50 do Cirkel(100,100,i);
for i:=1 to 25 do Cirkel(100,400,i*2);
for i:=1 to 10 do Cirkel(400,400,i*5);
for i:=1 to 5 do Cirkel(400,100,i*10);
Tekst(300,10,1,1,'Tryk <RETURN> for afslutning.');
readln(hkar);
Videobillede;
end.
(**********************-- PASGRAF --***************************************
>>>>>>>>>>> Copyright (c) 1985, ICL A/S - Ulrich Lysdal Jensen <<<<<<<<<<<<
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!! !!!!!!!!!!!
!!!!!!!!!! ICL A/S PÅTAGER SIG IKKE NOGET ANSVAR FOR !!!!!!!!!!!
!!!!!!!!!! EVENTUELLE FEJL ELLER MANGLER I DETTE PROGRAMMEL. !!!!!!!!!!!
!!!!!!!!!! !!!!!!!!!!!
!!!!!!!!!! PROGRAMMELLET MÅ KUN MED ICL's SKRIFTLIGE !!!!!!!!!!!
!!!!!!!!!! GODKENDELSE ANVENDES I KOMMERCIELT ØJEMED. !!!!!!!!!!!
!!!!!!!!!! !!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
###########################################################################
Disse PASCAL-procedurer udfører de grundlæggende grafiske operationer:
Status Undersøger om grafikprocessoren er klar til
en ny kommando.
GrafBillede1: Skifter til grafikbillede nr. 1.
GrafBillede2: Skifter til grafikbillede nr. 2.
VideoBillede: Skifter til videobilledet.
GrafInit: Initierer for grafik - se spec. i proceduren.
SletBillede: Sletter det viste grafikbillede.
PenNed: Sætter pen til tegning.
PenOp: Sætter pen til ikke tegne.
EraseNed: Sætter pen til sletning (viskelæder).
EraseOp: Sætter pen til ikke sletning (samme effekt som
PenOp ved flytning af pennen).
KarSize(ch,cy): Sætter karakterstørrelse - se spec. i proc.
LinieType(l): Sætter linietype for tegning - se spec. i proc.
KarType(k): Sætter karaktertype ved tekst - se spec. i proc.
MovePen(x,y): Flytter pennen fra nuværende position til (x,y).
Der tegnes/slettes i overensstemmelse med gældende
pen/eraser op/ned.
MoveTo(x,y): Flytter pennen uden tegning til (x,y).
DrawTo(x,y): Tegner linie fra nuværende position til (x,y).
EraseTo(x,y): Sletter linie fra nuværende position til (x,y).
PrikOn(x,y): Tænder en pixel i (x,y).
PrikOff(x,y): Slukker en pixel i (x,y).
Cirkel(x,y,r): Tegner cirkel m. centrum (x,y) og radius r.
Tekst(x,y,cx,cy,strg): Skriver teksten strg startende i (x,y)
med karakterstørrelsen cx,cy.
Grafikskærmens dimensioner er 512 x 512 pixels, der adresseres i et
koordinatsæt med (0,0) i skærmens nederste venstre hjørne, dvs.
x og y ligger i intervallet 0 til 511.
BEMÆRK: Med rutinerne MovePen, MoveTo, DrawTo og EraseTo må der højest
tegnes/flyttes eller slettes over afstande, der svarer til en til-
vækst i X- og/el. Y-retningen på max. 510 pixels.
Denne fil - PASGRAF.PAS - kan anvendes som include-fil i et PASCAL-program.
I den aktuelle anvendelse kan visse procedurer evt. udelades, men brugeren
må være opmærksom på, at de enkelte procedurer kalder hinanden indbyrdes,
hvorfor kriteriet for sletning IKKE alene er, at proceduren ikke forekommer
i brugerens programdel.
Et eksempel på anvendelse af disse procedurer findes i programmet TESTGRAF.
Lyngby, den 16. august 1985 / Ulrich Lysdal Jensen.
##########################################################################*)
TYPE
streng = string(.80.); (* Anvendes i Tekst *)
procedure Status; (*********************************************)
(* Checker om grafikprocessor klar til ny kommando *)
begin
while port(.160.) AND $F4 = 0 do;
end;
procedure GrafBillede1; (*********************************************)
(* Vælger grafikbillede nr. 1 *)
begin
port(.176.) := 255;
port(.179.) := 0;
end;
procedure GrafBillede2; (*********************************************)
(* Vælger grafikbillede nr. 2 *)
begin
port(.176.) := 255;
port(.179.) := 255;
end;
procedure VideoBillede; (***********************************************)
(* Vælger videobilledet *)
begin
port(.176.) := 0;
end;
procedure GrafInit; (***********************************************)
(* Initiering af grafikmodul:
- Billede 1 og 2 blankstilles
- X-reg = Y-reg. = DX-reg. = DY-reg. = 0
- Pen DOWN
- CHX = CHY = 1
- Kontinuert linietype
- Lodret skrift på vandret linie
- RMW OFF
Efter udførelse af GrafInit vises grafikbillede nr. 1*)
begin
GrafBillede2;
port(.160.) := 7;
GrafBillede1;
port(.160.) := 7;
port(.177.) := 0;
end;
procedure SletBillede; (****************************************)
(* Sletter det viste grafikbillede *)
begin
port(.160.) := 7;
end;
procedure PenNed; (***************************************)
(* Sætter Pen DOWN - skrive *)
begin
port(.160.) := 0;
port(.160.) := 2;
end;
procedure PenOp; (**************************************)
(* Sætter Pen UP - flytte uden skrive *)
begin
port(.160.) := 0;
port(.160.) := 3;
end;
procedure EraseNed; (**************************************)
(* Sætter Eraser DOWN - sletter *)
begin
port(.160.) := 1;
port(.160.) := 2;
end;
procedure EraseOp; (**************************************)
(* Sætter Eraser UP - flytte uden slette *)
begin
port(.160.) := 1;
port(.160.) := 2;
end;
procedure KarSize(x,y: integer); (***************************************)
(* Sætter karakterstørrelsen CHX = x og CHY = y
x/y = <1...16> (1 = mindste karakterstørrelse).
Hvis x og/el. y > 16 sættes værdien til 16.
BEMÆRK: intervallet for x og y er forskellig fra det for grafikmodulet
specificerede. *)
begin
if x>=16 then x:=0;
if y>=16 then y:=0;
port(.163.) := x*16+y;
end;
procedure LinieType(l: integer); (***************************************)
(* Sætter linietype til l: 0 => kontinuert linietype ______
1 => punkteret linietype ......
2 => stiplet linietype ------
3 => stiplet/punkteret linietype _._._.
Hvis l > 3 sættet kontinuert linietype *)
begin
if l > 3 then l:=0;
port(.162.) := (port(.162.) AND $FC) + l;
end;
procedure KarType(k: integer); (**************************************)
(* Sætter karaktrtype til k: 0 => lodret skrift på vandret linie
1 => skrå skrift på vandret linie
2 => lodret skrift på lodret linie
3 => skrå skrift på lodret linie
Hvis k > 3 sættes lodret skrift på vandret linie *)
begin
if k > 3 then k:=0;
port(.162.) := (port(.162.) AND $F3) + k*4;
end;
procedure MovePen(x,y: integer); (*************************************)
(* Bevæger pen/eraser fra nuværende koordinater (X-reg,Y-reg) til (x,y)
Under flytningen tegnes/slettes i overensstemmelse med valget af
pen/eraser op/ned.
Der kan maksimalt flyttes en afstand svarende til en tilvækst i
X- og/el. Y-retningen på 510 pixels. *)
Var
i,kommando,mx,my,mdx,mdy: integer;
begin
mx := port(.168.)*256 + port(.169.);
my := port(.170.)*256 + port(.171.);
mdx := x - mx;
mdy := y - my;
port(.165.) := ABS(mdx) DIV 2;
port(.167.) := ABS(mdy) DIV 2;
if mdx>0 then
if mdy>0 then
kommando := 17
else
kommando := 21
else
if mdy>0 then
kommando := 19
else
kommando := 23;
port(.160.) := kommando;
Status;
port(.165.) := ABS(mdx) - port(.165.);
port(.167.) := Abs(mdy) - port(.167.);
port(.160.) := kommando;
end;
procedure MoveTo(x,y: integer); (*************************************)
(* Flytter pen oppe (ikke skrive) til (x,y).
Tilvæksten i X- og/el. Y-retningen må højest være 510 pixels. *)
begin
PenOp;
MovePen(x,y);
end;
procedure DrawTo(x,y: integer); (************************************)
(* Tegner ret linie fra gældende koordinater (X-reg,Y-reg) til (x,y).
Tilvæksten i X- og/el. Y-retningen må højest være 510 pixels.
Den rette linie tegnes med gældende linietype - se LinieType. *)
begin
PenNed;
MovePen(x,y);
end;
procedure EraseTo(x,y: integer); (*************************************)
(* Sletter en ret linie fra gældende koord. (X-reg,Y-reg) til (x,y).
Tilvæksten i X- og/el. Y-retningen mø højest være 510 pixels. *)
begin
EraseNed;
MovePen(x,y);
end;
procedure PrikOn(x,y: integer); (*************************************)
(* Sætter prikken i (x,y) lysende *)
begin
MoveTo(x,y);
PenNed;
port(.160.) := 128;
end;
procedure PrikOff(x,y: integer); (*************************************)
(* Slukker prikken i (x,y) *)
begin
MoveTo(x,y);
EraseNed;
port(.160.) := 128;
end;
procedure Cirkel(x,y,r: integer); (*************************************)
(* Tegner cirkel med centrum i (x,y) og radius r.
Linietypen er altid kontinuert. *)
Var
cx,cy,s: integer;
begin
cx := r;
cy := 0;
s := r - 2*cx;
while cx >= cy do
begin
PrikOn(x+cx,y+cy);
PrikOn(x+cy,y+cx);
PrikOn(x-cy,y+cx);
PrikOn(x-cx,y+cy);
PrikOn(x-cx,y-cy);
PrikOn(x-cy,y-cx);
PrikOn(x+cy,y-cx);
PrikOn(x+cx,y-cy);
s := s + 2*cy + 1;
cy := cy + 1;
if s >= 0 then
begin
s := s - 2*cx + 2;
cx := cx - 1;
end;
end;
end;
procedure Tekst(x,y,cx,cy: integer; strg: streng); (*******************)
(* Skriver en tekst indeholdt i strg, startende i (x,y).
karakterstørrelse er bestemt af cx,cy.
karaktertypen er den gældende - se KarType. *)
Var
ti: integer;
begin
MoveTo(x,y);
PenNed;
KarSize(cx,cy);
for ti:=1 to len(strg) do
begin
port(.160.) := ord(strg(.ti.));
Status;
end;
end;
(***********************-- Slut PASGRAF --*********************************)
«eof»