Interface Oric-PC (9)

Par J.Marc DURO.

Nous arrivons maintenant au programme Pascal complet du terminal PC graphique pour Oric. Il est composé de 4 modules écrits en Turbo Pascal 6.0 :

le programme principal, sim_oric.pas
une unité de gestion de fenêtres, wins.pas
une unité de gestion de liste chaînées bilatères, maillon.pas
une unité de fonctions complémentaires, library.pas
Côté Oric, le petit programme d'exemple dataoric.bas n'a d'autre prétention que de dérouler une séquence complète d'envois au PC pour tester toutes les fonctions de l'émulateur.

Il n'y a pas de traducteur BASIC vers code émulateur. Il appartient à chacun de développer sa librairie de fonctions.

Sim_oric.pas

 

uses crt, dos, graph, library, wins, maillon;
CONST
{ Function keys }
_ShtTab = #134; _AltSpace = #143;
_F1 = #155; _ShtF1 = #165; _CtlF1 = #175; _AltF1 = #185;
_F2 = #156; _ShtF2 = #166; _CtlF2 = #176; _AltF2 = #186;
_F3 = #157; _ShtF3 = #167; _CtlF3 = #177; _AltF3 = #187;
_F4 = #158; _ShtF4 = #168; _CtlF4 = #178; _AltF4 = #188;
_F5 = #159; _ShtF5 = #169; _CtlF5 = #179; _AltF5 = #189;
_F6 = #160; _ShtF6 = #170; _CtlF6 = #180; _AltF6 = #190;
_F7 = #161; _ShtF7 = #171; _CtlF7 = #181; _AltF7 = #191;
_F8 = #162; _ShtF8 = #172; _CtlF8 = #182; _AltF8 = #192;
_F9 = #163; _ShtF9 = #173; _CtlF9 = #183; _AltF9 = #193;
_F10 = #164; _ShtF10 = #174; _CtlF10 = #184; _AltF10 = #194;
_Home = #195; _Up = #196; _PgUp = #197; _Left = #198;
_Right = #199; _End = #200; _Down = #201; _PgDn = #202;
_Ins = #203; _Del = #204;
_CtlImpr = #205; _CtlLeft = #206; _CtlRight = #207; _CtlEnd = #208;
_CtlPgDn = #209; _CtlHome = #210; _CtlPgUp = #211;
_CtlIns = #212; _ShtIns = #213; _CtlDel = #214; _ShtDel = #215;
_Alt1 = #216; _Alt2 = #217; _Alt3 = #218; _Alt4 = #219; _Alt5 = #220;
_Alt6 = #221; _Alt7 = #222; _Alt8 = #223; _Alt9 = #224; _Alt0 = #225;
_AltA = #226; _AltB = #227; _AltC = #228; _AltD = #229;
_AltE = #230; _AltF = #231; _AltG = #232; _AltH = #233;
_AltI = #234; _AltJ = #235; _AltK = #236; _AltL = #237;
_AltM = #238; _AltN = #239; _AltO = #240; _AltP = #241;
_AltQ = #242; _AltR = #243; _AltS = #244; _AltT = #245;
_AltU = #246; _AltV = #247; _AltW = #248; _AltX = #249;
_AltY = #250; _AltZ = #251;
{ Normal keys }
_Bksp = #08; _Enter = #13; _Tab = #09; _Esc = #27; _Space = #32;
_CtlBksp = #127; _CtlEnter = #10;
0 = $01;
D1 = $02;
D2 = $04;
DATA = $10;
TYPE
PORT_ES = OBJECT
{ adresse des registres du port imprimante }
DataAddress, { adresse du registre de données }
StatusAddress, { adresse du registre de statut }
ControlAddress: WORD; { adresse du registre de contrôle }
OldData, { sauvegarde du registre de données }
OldReg2: BYTE; { sauvegarde du registre de contrôle }
CONSTRUCTOR Init(address: WORD);
DESTRUCTOR Done;
PROCEDURE Strobe;
FUNCTION ReadQuint: BYTE;
FUNCTION ReadByte: BYTE;
PROCEDURE WriteByte(n: BYTE);
FUNCTION ReadWord: WORD;
FUNCTION ReadString: string;
FUNCTION ListNum: byte;
FUNCTION ListItem(l: UNELISTE): byte;
FUNCTION Abscisse(Hires: Boolean): integer;
FUNCTION Ordonnee(Hires: Boolean): integer;
FUNCTION Angle: word;
FUNCTION WinNum: byte;
END;
type
elements = array[1..128] of string[2];
VAR
GraphPilote, GraphMode : INTEGER;
Graphique: Boolean;
Listes: ARRAY[1..16] OF UNELISTE;
Liste_courante: BYTE;
Entree: PORT_ES;
 
function strtok(chaine: string; separateur: char; var resultat: elements): byte;
var
i, nb_elements: byte;
s: string;
begin
s := chaine;
for i := 1 to 128 do resultat[i] := '';
nb_elements := 0;
s := LTrim(s);
while length(s)>0 do begin inc(nb_elements);
i := pos(separateur, s);
if i<>0 then begin
resultat[nb_elements] := upper(Left(s, i-1));
Delete(s, 1, i);
end else begin
resultat[nb_elements] := upper(s);
s := '';
end;
s := LTrim(s);
end;
strtok := nb_elements;
end;
function hextonum(s: string): longint;
const
digit: string[16] = '0123456789ABCDEF';
var
l: longint;
i, p: byte;
begin
l := 0;
for i := 1 to length(s) do
l := l + (pos(s[i], digit)-1) * trunc(exp((length(s)-i)*ln(16)));
hextonum := l;
end;
var
f: text;
reste: byte;
resultat: elements;
function next(var b: byte): boolean;
var
s: string;
i: byte;
begin
if reste = 0 then begin
if not eof(f) then begin
repeat
readln(f, s);
Delay(2000);
until eof(f) or ((s<>'') and (s[1] <> ';'));
reste := strtok(s, ' ', resultat);
end else begin
next := false;
exit;
end;
end;
b := hextonum(resultat[1]);
for i := 1 to reste-1 do resultat[i] := resultat[i+1];
dec(reste);
next := true;
end;
CONSTRUCTOR PORT_ES.Init(address: WORD);
BEGIN
{ déDernierit les addresses des registres du port }
DataAddress := Address;
StatusAddress := Address + 1;
ControlAddress := Address + 2;
{ sauve les contenus des registres }
OldData := port[DataAddress];
OldReg2 := port[ControlAddress];
port[ControlAddress] := $FD;
END;
{ restaure les contenus des registres }
DESTRUCTOR PORT_ES.Done;
BEGIN
port[DataAddress] := OldData;
port[ControlAddress] := OldReg2;
END;
{ lit l'état des entrées du port imprimante }
FUNCTION PORT_ES.ReadQuint: BYTE;
VAR
PortData: BYTE;
BEGIN
PortData := port[StatusAddress];
ReadQuint := ((PortData or 7) div 8) xor $10;
END;
{ génère l'impulsion de strobe }
PROCEDURE PORT_ES.Strobe;
VAR
i: BYTE;
BEGIN
i := port[ControlAddress];
port[ControlAddress] := i and $1E; { strobe a 0 }
port[ControlAddress] := i or 1; { strobe a 1 }
END;
PROCEDURE PORT_ES.WriteByte(n: BYTE);
BEGIN
port[DataAddress] := n;
Strobe;
END;
{ attend qu'une donnée soit présente et lit un octet sur le port imprimante }
FUNCTION PORT_ES.ReadByte: BYTE;
VAR
PortDat, Data: BYTE;
BEGIN
if next(Data) then
ReadByte := Data
else
ReadByte := 0;
Exit;
{ boucle }
REPEAT
{ lit l'état des entrées du port imprimante }
PortDat := ReadQuint;
{ jusqu'à ce que la ligne Busy soit activée = donnée présente }
UNTIL (PortDat and DATA) <> DATA;
{ Stocke le quartet de poids faible }
Data := PortDat and $0F;
{ Active D1 = sélection poids fort / poids faible }
WriteByte(D1);
{ lit l'état des entrées du port imprimante }
PortDat := ReadQuint;
{ Stocke le quartet de poids fort }

ReadByte := Data or ((PortDat and $0F) shl 4);
{ active D0, D1 et D2 = RAZ tampon U1 et Ack vers Oric }
WriteByte(D0 OR D1 OR D2);
delay(10); { fait durer le signal ack pour l'Oric }
{ RAZ D0 et D2 == retour Ó la normale }
WriteByte($00);
END;
{ lit un mot de 16 bits sur le port imprimante }
FUNCTION PORT_ES.ReadWord: WORD;
VAR
PortDat: byte;
Data: word;
BEGIN
PortDat := Entree.ReadByte;
Data := PortDat * 256;
PortDat := Entree.ReadByte;
ReadWord := Data + PortDat;
END;
{ lit une chaîne de caractères sur le port imprimante }
FUNCTION PORT_ES.ReadString: string;
VAR
PortDat: byte;
Result: string;
BEGIN
Result := '';
REPEAT
PortDat := Entree.ReadByte;
IF PortDat<>0 THEN Result := Result + chr(PortDat);
UNTIL PortDat = 0;
ReadString := Result;
END;
{ lit un numéro de liste sur le port imprimante }
FUNCTION PORT_ES.ListNum: byte;
VAR
n: byte;
BEGIN
n := Entree.ReadByte;
IF n > 16 THEN
ErrMsg('Le numéro de liste doit être compris entre 1 et 16 !')
ELSE
ListNum := n;
END;
{ lit un numéro d'item de liste sur le port imprimante }
FUNCTION PORT_ES.ListItem(l: UNELISTE): byte;
VAR
n: byte;
BEGIN
n := Entree.ReadByte;
IF n > l.nombre THEN
ErrMsg('Le numéro sélectionné est supérieur au nombre d''items de la liste !')
ELSE
ListItem := n;
END;
{ lit une abscisse sur le port imprimante }
FUNCTION PORT_ES.Abscisse(Hires: Boolean): integer;
VAR
x: Integer;
BEGIN
IF Hires THEN BEGIN
x := Entree.ReadWord;
IF x > 32767 THEN x := x - 65536;
IF x > 639 THEN BEGIN
RestoreCrtMode;
ErrMsg('x doit être compris entre 0 et 639 !');
END;
END ELSE BEGIN
x := Entree.ReadByte;
IF x > 127 THEN x := x - 256;
IF x > 80 THEN
ErrMsg('x doit être compris entre 1 et 80 !');
END;
Abscisse := x;
END;
{ lit une ordonnée sur le port imprimante }
FUNCTION PORT_ES.Ordonnee(Hires: Boolean): integer;
VAR
y: integer;
BEGIN
IF Hires THEN BEGIN
y := Entree.ReadWord;
IF y > 32767 THEN y := y - 65536;
IF y > 479 THEN BEGIN
RestoreCrtMode;
ErrMsg('y doit être compris entre 0 et 479 !');
END;
END ELSE BEGIN
y := Entree.ReadByte;
IF y > 127 THEN y := y - 256;
IF y > 25 THEN
ErrMsg('y doit être compris entre 1 et 25 !');
END;
Ordonnee := y;
END;
{ lit un angle sur le port imprimante }
FUNCTION PORT_ES.Angle: word;
VAR
n: word;
BEGIN
n := Entree.ReadWord;
IF n > 360 THEN
ErrMsg('L''angle doit être compris entre 0° et 360° !')
ELSE
Angle := n;
END;
{ lit un numéro de fenêtre sur le port imprimante }
FUNCTION PORT_ES.WinNum: byte;
VAR
n: byte;
BEGIN
n := Entree.ReadByte;
IF n > 10 THEN
ErrMsg('Le numéro de fenêtre doit être compris entre 1 et 10 !')
ELSE
WinNum := n;
END;
VAR
Intense: Array[1..12] OF Byte;
PROCEDURE Selection(lig, x, y, max: Byte; Choisi: Boolean);
VAR
Caract, i, j: Integer;
BEGIN
IF choisi THEN BEGIN
ChgAttr(x, y+Lig-1, $70, Max+2);
ChgAttr(x+Intense[Lig]-1, y+Lig-1, $74, 1);

 END ELSE BEGIN
ChgAttr(x, y+Lig-1, $30, Max+2);
ChgAttr(x+Intense[Lig]-1, y+Lig-1, $34, 1);
END;
END;
 
FUNCTION Clavier: char;
VAR
n: char;
a208, a209: byte;
BEGIN
a208 := Entree.ReadByte;
a209 := Entree.ReadByte;
CASE a209 OF
0 :
CASE a208 OF
128 : n:='7'; 129 : n:='J'; 130 : n:='M';
131 : n:='K'; 132 : n:=' '; 133 : n:='U';
134 : n:='Y'; 135 : n:='8'; 136 : n:='N';
137 : n:='T'; 138 : n:='6'; 139 : n:='9';
140 : n:=','; 141 : n:='I'; 142 : n:='H';
143 : n:='L'; 144 : n:='5'; 145 : n:='R';
146 : n:='B'; 147 : n:=';'; 148 : n:='.';
149 : n:='O'; 150 : n:='G'; 151 : n:='0';
152 : n:='V'; 153 : n:='F'; 154 : n:='4';
155 : n:='|'; 156 : n:=_up; 157 : n:='P';
158 : n:='E'; 159 : n:='?'; 168 : n:='1';
169 : n:=_esc; 170 : n:='Z'; 171 : n:= #0;
172 : n:=_left; 173 : n:=_bksp; 174 : n:='A';
175 : n:=_enter; 176 : n:='X'; 177 : n:='Q';
178 : n:='2'; 179 : n:='-'; 180 : n:=_down;
181 : n:=']'; 182 : n:='S'; 183 : n:= #0;
184 : n:='3'; 185 : n:='D'; 186 : n:='C';
187 : n:=''''; 188 : n:=_right; 189 : n:='[';
190 : n:='W'; 191 : n:='=';
END;
162: { CTRL }
CASE a208 OF
128 : n:=_ctlF7; 129 : n:=#10; 130 : n:=#13;
131 : n:=#11; 132 : n:=' '; 133 : n:=#21;
134 : n:=#25; 135 : n:=_ctlF8; 136 : n:=#14;
137 : n:=#20; 138 : n:=_ctlF6; 139 : n:=_ctlF9;
140 : n:=','; 141 : n:=#9; 142 : n:=#8;
143 : n:=#12; 144 : n:=_ctlF5; 145 : n:=#18;
146 : n:=#2; 147 : n:=';'; 148 : n:='.';
149 : n:=#15; 150 : n:=#7; 151 : n:=_ctlF10;
152 : n:=#22; 153 : n:=#6; 154 : n:=_ctlF4;
155 : n:='|'; 156 : n:=_up; 157 : n:=#16;
158 : n:=#5; 159 : n:='?'; 168 : n:=_ctlF1;
169 : n:=_esc; 170 : n:=#26; 171 : n:=#0;
172 : n:=_ctlleft; 173 : n:=_del; 174 : n:=#1;
175 : n:=_enter; 176 : n:=#24; 177 : n:=#17;
178 : n:=_ctlF2; 179 : n:='-'; 180 : n:=_down;
181 : n:=']'; 182 : n:=#19; 183 : n:=#0;
184 : n:=_ctlF3; 185 : n:=#4; 186 : n:=#3;
187 : n:=''''; 188 : n:=_ctlright; 189 : n:='[';
190 : n:=#23; 191 : n:='=';
END;
164, 167: { SHIFT }
CASE a208 OF
128 : n:='&'; 129 : n:='j'; 130 : n:='m';
131 : n:='k'; 132 : n:=' '; 133 : n:='u';
134 : n:='y'; 135 : n:='*'; 136 : n:='n';
137 : n:='t'; 138 : n:='^'; 139 : n:='(';
140 : n:='<'; 141 : n:='i'; 142 : n:='h';
143 : n:='l'; 144 : n:='%'; 145 : n:='r';
146 : n:='b'; 147 : n:=':'; 148 : n:='>';
149 : n:='o'; 150 : n:='g'; 151 : n:=')';
152 : n:='v'; 153 : n:='f'; 154 : n:='$';
155 : n:='\'; 156 : n:=_up; 157 : n:='p';
158 : n:='e'; 159 : n:='/'; 168 : n:='!';
169 : n:=_esc; 170 : n:='z'; 171 : n:=#0;
172 : n:=_left; 173 : n:=_bksp; 174 : n:='a';
175 : n:=_enter; 176 : n:='x'; 177 : n:='q';
178 : n:='@'; 179 : n:='£'; 180 : n:=_down;
181 : n:='}'; 182 : n:='s'; 183 : n:=#0;
184 : n:='#'; 185 : n:='d'; 186 : n:='c';
187 : n:='"'; 188 : n:=_right; 189 : n:='{';
190 : n:='w'; 191 : n:='+';
END;
165: { FUNCT }
CASE a208 OF
128 : n:=_F7; 129 : n:=_altJ; 130 : n:=_altM;
131 : n:=_altK; 132 : n:=' '; 133 : n:=_altU;
134 : n:=_altY; 135 : n:=_F8; 136 : n:=_altN;
137 : n:=_altT; 138 : n:=_F6; 139 : n:=_F9;
140 : n:=','; 141 : n:=_altI; 142 : n:=_altH;
143 : n:=_altL; 144 : n:=_F5; 145 : n:=_altR;
146 : n:=_altB; 147 : n:=';'; 148 : n:='.';
149 : n:=_altO; 150 : n:=_altG; 151 : n:=_F10;
152 : n:=_altV; 153 : n:=_altF; 154 : n:=_F4;
155 : n:='|'; 156 : n:=_pgup; 157 : n:=_altP;
158 : n:=_altE; 159 : n:='?'; 168 : n:=_F1;
169 : n:=_esc; 170 : n:=_altZ; 171 : n:=#0;

172 : n:=_home; 173 : n:=_bksp; 174 : n:=_altA;
175 : n:=_enter; 176 : n:=_altX; 177 : n:=_altQ;
178 : n:=_F2; 179 : n:='-'; 180 : n:=_pgdn;
181 : n:=']'; 182 : n:=_altS; 183 : n:=#0;
184 : n:=_F3; 185 : n:=_altD; 186 : n:=_altC;
187 : n:=''''; 188 : n:=_end; 189 : n:='[';
190 : n:=_altW; 191 : n:='=';
END;
END;
Clavier := n;
END;
FUNCTION ListBox(x, y: word; l: UNELISTE; n: byte): word;
VAR
MaxLength, Lig, i, j, b, nb: byte;
ls: UNELISTE;
s: string;
code: char;
Done, ok: boolean;
BEGIN
ls.Init;
MaxLength := 0;
IF l.nombre > 22 THEN nb := 22 ELSE nb := l.nombre;
FOR i := 1 TO nb DO IF l.Extrait(i, s) THEN
IF Length(s)>MaxLength THEN MaxLength := Length(s);
done := OpenWin(11, x, y, x+MaxLength+3, y+nb+1, $03, '', Double, $30, $30);
FOR i := 1 TO nb DO BEGIN
IF l.Extrait(i, s) THEN BEGIN
s := Centrer(s, MaxLength+2, ' ');
ls.Ajoute(s);
Intense[i] := 0;
FOR j := 1 TO MaxLength+2 DO IF ls.Courant^.Chaine[j] IN ['A'..'Z'] THEN Intense[i] := j;
WriteStr(x+1, y+i, ls.Courant^.Chaine, $30);
ChgAttr(x+Intense[i], y+i, $34, 1);
END;
END;
Lig := n;
Done := False;
TailleCurseur(15, 0);
REPEAT
Selection(Lig, x+1, y+1, MaxLength, True);
b := Entree.ReadByte;
IF b = $19 THEN BEGIN
code := clavier;
CASE Code OF
_Up: BEGIN
Selection(Lig, x+1, y+1, MaxLength, False);
Dec(Lig);
IF Lig<1 THEN Lig := nb;
END;
_Left, _Right: BEGIN
Lig := 256*Ord(Code);
Done := True;
END;
_Down: BEGIN
Selection(Lig, x+1, y+1, MaxLength, False);
Inc(Lig);
IF Lig>nb THEN Lig := 1;
END;
_Enter: BEGIN
Done := True;
>END;
_Esc: BEGIN
Lig := 256*Ord(Code);
Done := True;
END;
'A'..'Z', 'a'..'z':
FOR i := 1 TO n DO BEGIN
ok := ls.Extrait(i, s);
IF UpCase(Code) = s[Intense[i]] THEN BEGIN
Lig := i;
Done := True;
END;
END;
END;
END;
UNTIL Done;
TailleCurseur(14, 15);
CloseWin(11);
ListBox := Lig;
END;
{ routine principale }
TYPE
item = RECORD
x: BYTE;
intense: BYTE;
sous_menu: BYTE;
chaine: STRING[20];
END;
barre_menu = RECORD
nb_items: BYTE;
raccourcis: STRING;
items: Array[1..12] OF item;
END;
VAR
InputData: byte;
done, d: boolean;
l, n, i, p: byte;
r, ad, af, rx, ry: word;
x, y: integer;
b, c, m: word;
x1, y1, x2, y2: integer;
s: string;
menu: barre_menu;
err: integer;
code: char;
BEGIN
textattr := $07;
assign(f, 'oric.txt');
reset(f);
reste := 0;
OpenWinsUnit;
ClrScr;
GraphPilote := Detect; InitGraph(GraphPilote, GraphMode, '');
IF GraphResult <> grOk THEN
ErrMsg('Impossible de passer en mode graphique !');
RestoreCRTMode;
{ Création des 16 listes de mots }
FOR i := 1 TO 16 DO Listes[i].Init;
Entree.Init($378);
{ RAZ tampon sortie Oric }
Entree.WriteByte(D2); { Active D2 }
Entree.WriteByte($00); { RAZ D2 }
done := false;
REPEAT
{ attend la présence d'une instruction sur le port imprimante }
InputData := Entree.ReadByte;
{ la traite }
CASE InputData OF
{ Gestion du mode vidéo }
$2E : BEGIN { TEXT }
RestoreCRTMode;
Graphique := False;
END;
$16 : BEGIN { HIRES }
SetGraphMode(GetGraphMode);
Graphique := True;
END;
{ Gestion des listes de chaînes de caractères }
$0F : BEGIN { DECLST # }
l := Entree.ListNum;
n := Entree.ReadByte;
for i := 1 to n do Listes[l].Ajoute(Entree.ReadString);
END;
$02 : BEGIN { APPEND # }
l := Entree.ListNum;
n := Entree.ReadByte;
WITH Listes[l] DO BEGIN
AllerA(n); Insere(Entree.ReadString);
END;
END;
$2C : BEGIN { SELLST # }
Liste_courante := Entree.ListNum;
END;
$2D : BEGIN { SORT # }
l := Entree.ListNum;
Listes[l].Trie;
END;
$27 : BEGIN { PRINT # }
n := Entree.ReadByte;
WITH Listes[Liste_courante] DO
IF Extrait(n, s) THEN
case s[length(s)] of
';' : Write(s);
',' : Write(s+_Tab);
else Writeln(s);
end;
END;
$1D : BEGIN { LSTBOX # }
l := Entree.ListNum;
x := Entree.Abscisse(False);
y := Entree.Ordonnee(False);
n := Entree.ListItem(Listes[l]);
r := ListBox(x, y, Listes[l], n);
END;
{ Gestion de fenêtres }
$01 : BEGIN { ACTWIN # }
l := Entree.WinNum;
ActiveWin(l);
END;
$0B : BEGIN { CLRWIN # }
l := Entree.WinNum;
WITH WinList[l] DO ClrWin(x, y, w, h, Attr);
END;
$0C : BEGIN { CLSWIN # }
l := Entree.WinNum;
CloseWin(l);
END;
$15 : BEGIN { FRAME # }
l := Entree.WinNum;
n := Entree.ReadByte;
WITH WinList[l] DO
CASE n OF
0: UnFrameWin(l);
1: FrameWin(l, Title, Single, TitleAttr, FrameAttr);
2: FrameWin(l, Title, Double, TitleAttr, FrameAttr);
ELSE ErrMsg('Type de cadre incorrect !');
END;
END;
$1F : BEGIN { OPNWIN # }
l := Entree.WinNum;

x1 := Entree.Abscisse(False);
y1 := Entree.Ordonnee(False);
x2 := Entree.Abscisse(False);
y2 := Entree.Ordonnee(False);
s := Entree.ReadString;
i := Entree.ReadByte;
IF i = 0 THEN
d := OpenWin(l, x1, y1, x2, y2, TextAttr, s, None, TextAttr, TextAttr)
ELSE
d := OpenWin(l, x1, y1, x2, y2, TextAttr, s, Double, TextAttr, TextAttr);
END;
$09 : BEGIN { CLREOL }
ClrEol;
END;
$0A : BEGIN { CLS }
if Graphique = False THEN
ClrScr
ELSE
ClearViewPort;
END;

Les articles du mois