Affichage dynamique sous Turbo Vision

**Paul TOTH** · 23/06/2012, 11h44

ça me rappelle la belle époque des développements sous DOS

je me souviens avoir développé des fonctions graphique en mode caractère !
le principe était de faire une matrice de caractères :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 ABCDEFG
 HIJKLMN
 OPQRSTU

et de redéfinir chaque caractère, au départ vide puis en allumant les pixels selon les besoins

si je me souviens bien il était même possible d'étendre l'affichage avec 2 pages de caractères, la première classique et la seconde pour les graphismes.

**Roland Chastain** · 23/06/2012, 12h25

Envoyé par Paul TOTH

le principe était de faire une matrice de caractères :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 ABCDEFG
 HIJKLMN
 OPQRSTU

et de redéfinir chaque caractère, au départ vide puis en allumant les pixels selon les besoins

Je pourrais faire quelque chose de ce style pour ma grille. C'est un tableau de caractères de toute façon :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
procedure TGrilleView.Draw;
 
var X, Y, I: Integer;
 
begin
 
  inherited Draw;
 
  for Y := 5 downto 0 do
 
    for X := 0 to 6 do
 
      begin
 
        WriteChar(2, 11 - 2 * Y, chr(178), 2, 23);
 
        WriteChar(3 * X + 1, 12 - 2 * Y, chr(178), 2 ,2);
 
        if not(Grille.Grille[X, Y] = Neant) then
 
          WriteChar
 
          (
 
          3 * X + 4,
 
          12 - 2 * Y,
 
          Chr(219),
 
          IIf(Grille.Grille[X, Y] = Rouge, PionRouge, PionJaune),
 
          1
 
          );
 
        WriteChar(3 * X + 5, 12 - 2 * Y, chr(178), 2, 2);
 
        WriteChar(2, 13 - 2 * Y, chr(178), 2, 23);
 
      end;
 
end;

Il ne reste qu'à le déclarer.

**Roland Chastain** · 23/06/2012, 13h18

@wormful_sickfoot

J'ai trouvé les 3 caractères "fautifs" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
  for Y := 0 to 48 do
  begin
    WriteStr(0, Y, #186 + '      ', 2);
    for X := 1 to 6 do
      WriteStr(X * 7, Y, #179 + '      ', 2);
    WriteChar(49, Y, #186, 2, 1);
  end;
  for Y := 0 to 5 do
    for X := 0 to 6 do
    begin
      WriteStr(0, Y * 7 + 6, {#199}#186#196#196#196#196#196#196, 2);
      for X := 1 to 6 do
        WriteStr(X * 7, Y * 7 + 6, #197#196#196#196#196#196#196, 2);
        {WriteChar(49, Y * 7 + 6, #182, 2, 1);}
    end;
  WriteStr(0, 41, #200#205#205#205#205#205#205, 2);
  for X := 1 to 6 do
    WriteStr(X * 7, 41, {#207}#205#205#205#205#205#205#205, 2);
  WriteChar(49, 41, #188, 2, 1);

Ce qui est curieux (mais qui tombe bien) c'est qu'une fois la correction faite, l'affichage sous DosBox reste inchangé.

**M.Dlb** · 23/06/2012, 17h08

Ce n'est qu'une question de code page, que tu peux changer sous DOS (donc je présume sous DOSBox également).

Quant à l'affichage sous DOSBox ou en natif, comme tu n'as aucun pouvoir sur le rendu, il ne faut pas trop s'en préoccuper. Si tu veux vraiment choisir un rendu, il faut se tourner vers les librairies graphiques, type SDL, où là tu peux TOUT choisir !

**Paul TOTH** · 23/06/2012, 17h28

Ahaha ! j'ai retrouvé mon code

Nom : textgraph.jpg
Affichages : 66
Taille : 30,7 Ko

c'est du mode texte ! par contre c'est monochrome, on pourrait colorer par paquets de 8x8 (comme les lettres puisqu'on est en mode texte), mais là tout se joue sur SetPixel (blanc) et ClearPixel (noir)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
 
Program TextGraph;
 
uses crt;
 
Const
{-$DEFINE CO80}
{$DEFINE CO40}
{$DEFINE FONT8X8}
{$DEFINE X200}
 
{$IFDEF CO80}
 TM=CO80{$IFDEF FONT8X8}+FONT8X8{$ENDIF};
{$ENDIF}
{$IFDEF CO40}
 TM=CO40{$IFDEF FONT8X8}+FONT8X8{$ENDIF};
{$ENDIF}
 TW=80{$IFDEF CO40}div 2{$ENDIF};
 TH=25{$IFDEF FONT8x8}{$IFNDEF X200}*2{$ENDIF}{$ENDIF};
 TL=16{$IFDEF FONT8x8}div 2{$ELSE}{$IFDEF X200}div 2{$ENDIF}{$ENDIF};
 GW=24; { Graph Width }
 GH=512 div GW; { Graph Heigh }
 MX= 8*GW; { Max X }
 MY=TL*GH; { Max Y }
 ox=(TW-GW) div 2;
 oy=(TH-GH) div 2;
 FP=1;  { Font Page }
 
Type
 TFont=0..3;
 TFontRAM =array[0..2,0..511,0..31] of byte;
var
 FontRAM :TFontRAM absolute $A000:0000;
 
procedure LockChars;
 begin
  Inline($FA);
  PortW[$3C4] := $0402;
  PortW[$3C4] := $0704;
  PortW[$3CE] := $0204;
  PortW[$3CE] := $0005;
  PortW[$3CE] := $0006;
 end;
 
procedure UnLockChars;
 begin
  PortW[$3C4] := $0302;
  PortW[$3C4] := $0304;
  PortW[$3CE] := $0004;
  PortW[$3CE] := $1005;
  PortW[$3CE] := $0E06;
  Inline($FB);
 end;
 
Procedure SetChar(Font,ASCII:word; Var Data);
 begin
  LockChars;
  Move(Data,FontRAM[Font,ASCII],32);
  UnLockChars;
 end;
 
Procedure SetFont(A,B:TFont); assembler;
 asm
  mov ax,$1103
  mov BL,B
  shl BL,2
  add BL,A
  int 10h
 end;
 
Procedure GetColorIndex(Var Index); assembler;
 asm
  mov ax,$1009
  les dx,Index
  int 10h
 end;
 
Procedure SetColor(Index,R,G,B:byte);
 begin
  port[$3C8]:=Index;
  port[$3C9]:=r;
  port[$3C9]:=g;
  port[$3C9]:=b;
 end;
 
Function GetPixel(x,y:word):boolean;
 var
  block,ascii:word;
  plotx,ploty:word;
 begin
  block:=x div 8+GW*(y div TL);
  ascii:=block mod 256;
  block:=block div 256+FP;
  plotx:=$80 shr (x and 7);
  ploty:=y mod TL;
  LockChars;
  GetPixel:=(FontRAM[block,ascii,ploty] and plotx)>0;
  UnLockChars;
 end;
 
Procedure SetPixel(x,y:word);
 var
  block,ascii:word;
  plotx,ploty:word;
 begin
  block:=x div 8+GW*(y div TL);
  ascii:=block mod 256;
  block:=block div 256+FP;
  plotx:=$80 shr (x and 7);
  ploty:=y mod TL;
  LockChars;
  FontRAM[block,ascii,ploty]:=FontRAM[block,ascii,ploty] or plotx;
  UnLockChars;
 end;
 
Procedure ClearPixel(x,y:word);
 var
  block,ascii:word;
  plotx,ploty:word;
 begin
  block:=x div 8+GW*(y div TL);
  ascii:=block mod 256;
  block:=block div 256+FP;
  plotx:=not($80 shr (x and 7));
  ploty:=y mod TL;
  LockChars;
  FontRAM[block,ascii,ploty]:=FontRAM[block,ascii,ploty] and plotx;
  UnLockChars;
 end;
 
Procedure CopyChar(C:Char; X,Y:integer);
 var
  block,ascii:word;
  plot1,plot2,ploty:word;
  i,b:integer;
 begin
  block:=x div 8+GW*(y div TL);
  ascii:=block mod 256;
  block:=block div 256+FP;
  plot1:=(x and 7);
  plot2:=8-plot1;
  ploty:=y mod TL;
  LockChars;
  for i:=0 to TL-1 do begin
   b:=FontRAM[0,Ord(C),I];
   FontRAM[block,ASCII,ploty]:=FontRAM[block,ASCII,ploty] or (b shr plot1);
   FontRAM[block,ASCII+1,ploty]:=FontRAM[block,ASCII+1,ploty] or (b shl plot2);
   ploty:=(ploty+1) and 7;
   if ploty=0 then begin
    inc(ascii,GW);
    if ascii>255 then begin
     dec(ascii,256);
     inc(Block);
    end;
   end;
  end;
  UnLockChars;
 end;
 
Procedure OutTextXY(x,y:integer; s:string);
 var
  i:integer;
 begin
  for i:=1 to length(s) do begin
   CopyChar(s[i],x,y);
   inc(x,8);
  end;
 end;
 
Procedure HLine(x1,y,x2:integer);
 begin
  While x1<=x2 do begin
   SetPixel(x1,y);
   inc(x1);
  end;
 end;
 
Procedure VLine(x,y1,y2:integer);
 begin
  While y1<=y2 do begin
   SetPixel(x,y1);
   inc(y1);
  end;
 end;
 
Procedure ClearScreen;
 begin
  LockChars;
  FillChar(FontRAM[FP],2*512*32,0);
  UnLockChars;
 end;
 
Procedure DoLine(x1,y1,x2,y2:integer);
 var
  dx,dy:integer;
  ix,iy:integer;
  ex,ey:integer;
  ee,ii:integer;
 begin
  dx:=x2-x1; if dx<0 then begin dx:=-dx; ix:=-1 end else ix:=+1;
  dy:=y2-y1; if dy<0 then begin dy:=-dy; iy:=-1 end else iy:=+1;
  ex:=dx;
  ey:=dy;
  if ex<ey then ee:=ey else ee:=ex;
  for ii:=0 to ee do begin
   if (x1>=0)and(x1<MX)
   and(y1>=0)and(y1<MY) then SetPixel(x1,y1);
   inc(ex,dx);
   if ex>ee then begin
    dec(ex,ee);
    inc(x1,ix);
   end;
   inc(ey,dy);
   if ey>ee then begin
    dec(ey,ee);
    inc(y1,iy);
   end;
  end;
 end;
 
Procedure UnLine(x1,y1,x2,y2:integer);
 var
  dx,dy:integer;
  ix,iy:integer;
  ex,ey:integer;
  ee,ii:integer;
 begin
  dx:=x2-x1; if dx<0 then begin dx:=-dx; ix:=-1 end else ix:=+1;
  dy:=y2-y1; if dy<0 then begin dy:=-dy; iy:=-1 end else iy:=+1;
  ex:=dx;
  ey:=dy;
  if ex<ey then ee:=ey else ee:=ex;
  for ii:=0 to ee do begin
   if (x1>=0)and(x1<MX)
   and(y1>=0)and(y1<MY) then ClearPixel(x1,y1);
   inc(ex,dx);
   if ex>ee then begin
    dec(ex,ee);
    inc(x1,ix);
   end;
   inc(ey,dy);
   if ey>ee then begin
    dec(ey,ee);
    inc(y1,iy);
   end;
  end;
 end;
 
procedure DarkNess(x1,y1,x2,y2:integer);
 var
  dx,dy,count:integer;
  x,y:integer;
 begin
  dx:=x2-x1;
  dy:=y2-y1;
  count:=dx*dy;
  x:=x1;
  y:=y1;
  while count>0 do begin
   repeat
    inc(x,Random(dx));
    inc(y,Random(dy));
    if x>=x2 then dec(x,dx);
    if y>=y2 then dec(y,dy);
   until GetPixel(x,y)=false;
   SetPixel(x,y);
   dec(count);
  end;
 end;
 
procedure StarField(x1,y1,x2,y2:integer);
 const
  MAX=100;
  K=500;
 var
  Stars:array[0..MAX,0..5] of integer;
  i,j:integer;
  x,y,z:integer;
  mx,my:integer;
 begin
  mx:=(x2-x1) div 2;
  my:=(y2-y1) div 2;
  FillChar(Stars,SizeOf(Stars),0);
  repeat
   for i:=0 to MAX do begin
    SetPixel(Stars[i,4],Stars[i,5]);
    SetPixel(Stars[i,4]+1,Stars[i,5]);
    SetPixel(Stars[i,4]-1,Stars[i,5]);
    SetPixel(Stars[i,4],Stars[i,5]+1);
    SetPixel(Stars[i,4],Stars[i,5]-1);
  { end;
   for i:=0 to MAX do begin }
    z:=Stars[i,2];
    if z>0 then begin
     x:=K*Stars[i,0] div z+mx;
     y:=K*Stars[i,1] div z+my;
    end;
    if (z<=0)or(x<x1)or(y<y1)or(x>=x2)or(y>=y2) then begin
     Stars[i,0]:=Random(2*mx)-mx;
     Stars[i,1]:=Random(2*my)-my;
     Stars[i,2]:=Random(200);
     Stars[i,3]:=Random(2)+1;
    end else begin
     ClearPixel(x,y);
     ClearPixel(x+1,y);
     ClearPixel(x-1,y);
     ClearPixel(x,y+1);
     ClearPixel(x,Y-1);
     Stars[i,4]:=x;
     Stars[i,5]:=y;
     dec(Stars[i,2],Random(3)+1);
    end;
  end;
   while (port[$3da] and 8) <> 8 do;
   while (port[$3da] and 8) = 8 do;
  until keypressed;
 end;
 
procedure SetCircle(ox, oy, r: Integer);
var
  x, y, d: Integer;
begin
  x := 0;
  y := r;
  d := r - 1;
  while y >= x do
  begin
    SetPixel(ox + x, oy + y);
    SetPixel(ox - x, oy + y);
    SetPixel(ox - x, oy - y);
    SetPixel(ox + x, oy - y);
    SetPixel(ox + y, oy + x);
    SetPixel(ox - y, oy + x);
    SetPixel(ox - y, oy - x);
    SetPixel(ox + y, oy - x);
    if d >= 2 * (x - 1) then
    begin
      Dec(d, 2 * x);
      Inc(x);
    end else
    if d <= 2 * (r - y) then
    begin
      Inc(d, 2 * y - 1);
      Dec(y);
    end else begin
      Inc(d, 2 * (y - x - 1));
      Dec(y);
      Inc(x);
    end;
  end;
end;
 
procedure ClearCircle(ox, oy, r: Integer);
var
  x, y, d: Integer;
begin
  x := 0;
  y := r;
  d := r - 1;
  while y >= x do
  begin
    ClearPixel(ox + x, oy + y);
    ClearPixel(ox - x, oy + y);
    ClearPixel(ox - x, oy - y);
    ClearPixel(ox + x, oy - y);
    ClearPixel(ox + y, oy + x);
    ClearPixel(ox - y, oy + x);
    ClearPixel(ox - y, oy - x);
    ClearPixel(ox + y, oy - x);
    if d >= 2 * (x - 1) then
    begin
      Dec(d, 2 * x);
      Inc(x);
    end else
    if d <= 2 * (r - y) then
    begin
      Inc(d, 2 * y - 1);
      Dec(y);
    end else begin
      Inc(d, 2 * (y - x - 1));
      Dec(y);
      Inc(x);
    end;
  end;
end;
 
var
 x,y,z:integer;
 i:integer;
 Colors:array[0..16] of byte;
begin
 if GW*GH>512 then begin
  WriteLn('Graph  Size overflow : ',GH*GW);
  Halt;
 end;
{$IFDEF X200}
  asm mov ax,$1200; mov bl,$30; int 10h end; { 200 lines }
{$ENDIF}
 TextMode(TM);
 asm mov ax,$1003; mov bl,0; int 10h end; { no blink }
 SetFont(1,2);
 for x:=40 to 50 do SetColor(x,0,0,0);
 GetColorIndex(Colors);
 SetColor(Colors[8],0,0,0); { patch DarkGray color to Black }
{ SetColor(Colors[15],63,63,63); }
 FillChar(Mem[SegB800:0],2*80*50,0);
 
 ClearScreen;
 
 LockChars;
 FontRAM[2,$F8,1]:=127; for i:=2 to 8 do FontRAM[2,$F8,i]:=64;
 FontRAM[2,$F9,1]:=254; for i:=2 to 8 do FontRAM[2,$F9,i]:=2;
 FontRAM[2,$FA,6]:=254; for i:=0 to 5 do FontRAM[2,$FA,i]:=2;
 FontRAM[2,$FB,6]:=127; for i:=0 to 5 do FontRAM[2,$FB,i]:=64;
 FontRAM[2,$FC,1]:=255; for i:=0 to 7 do FontRAM[2,$FE,i]:=64;
 FontRAM[2,$FD,6]:=255; for i:=0 to 7 do FontRAM[2,$FF,i]:=2;
 For x:=$F8 to $FF do
  for y:=0 to 8 do
   FontRAM[2,x,y]:=255-FontRAM[2,x,y];
 UnLockChars;
 
{ draw border with some left chars }
 MemW[SegB800:2*((ox-1) +TW*(oy-1)) ]:=$9EF8;
 MemW[SegB800:2*((ox+GW)+TW*(oy-1)) ]:=$E9F9;
 MemW[SegB800:2*((ox+GW)+TW*(oy+GH))]:=$9EFA;
 MemW[SegB800:2*((ox-1) +TW*(oy+GH))]:=$E9FB;
 for x:=0 to GW-1 do begin
  MemW[SegB800:2*((ox+x)+TW*(oy-1 ))]:=$E9FC;
  MemW[SegB800:2*((ox+x)+TW*(oy+GH))]:=$E9FD;
 end;
 for y:=0 to GH-1 do begin
  MemW[SegB800:2*((ox-1) +TW*(oy+y))]:=$E9FE;
  MemW[SegB800:2*((ox+GW)+TW*(oy+y))]:=$E9FF;
 end;
 
{ draw graphic window }
 for y:=0 to GH-1 do
  for x:=0 to GW-1 do begin
   z:=x+GW*y;
   MemW[SegB800:2*((x+ox)+TW*(y+oy))]:=$F000+z and 255+$800*(z shr 8);
  end;
 
 HLine(1,1,MX-2);
 VLine(1,1,MY-2);
 HLine(1,MY-2,MX-2);
 VLine(MX-2,1,MY-2);
 HLine(1,12,MX-2);
 VLine(MX-12,12,MY-2);
 HLine(1,MY-12,MX-2);
 
 OutTextXY(3,3,'TextGraph demo');
 
 for x := 0 to MX div 3 do
   SetCircle(MX div 2, MY div 2, x);
 if readkey=#0 then readkey;
 for x := MX div 3 downto 0 do
   ClearCircle(MX  div 2, MY  div 2, x);
 DarkNess(3,14,MX-13,MY-13);
 StarField(3,14,MX-13,MY-13);
 if readkey=#0 then readkey;
 SetFont(0,2);
 readln;
 
 asm mov ax,$1202; mov bl,$30; int 10h { 400 lines } end;
 TextMode(CO80);
 WriteLn('This was a ',MX,'x',MY,' TextGraph mode (',GW*GH,' chars)');
end.

**Roland Chastain** · 23/06/2012, 19h16

Envoyé par Paul TOTH

c'est du mode texte ! par contre c'est monochrome, on pourrait colorer par paquets de 8x8 (comme les lettres puisqu'on est en mode texte), mais là tout se joue sur SetPixel (blanc) et ClearPixel (noir)

Très joli programme.