Accueil de Gladir.com Notes légal de Gladir.com Flux RSS des nouvelles du site Gladir.com - Free Pascal - Affichage & Graphique - L'instruction «DRAW» du BASIC Section du logiciel DOS «MonsterBook» Inventaire de la bibliothèque de Gladir.com Entrée administrateur

L'instruction «DRAW» qu'utilisait la plupart des langages BASIC des ordinateurs des années 1980 était un outil très rapide pour faire des dessins, il est tout a fait dommage que de nos jours cette connaissance ce soit perdu. En revanche, voici le code Turbo Pascal effectuant un dessin de «Boule» dans «Boule & Bill»:

  1. Program SamplesDraw;
  2.  
  3. Uses Crt,Graph;
  4.  
  5. Const
  6.  DrawS:Integer=4;
  7.  XL:Integer=160;
  8.  YL:Integer=100;
  9.  
  10. Var
  11.  I:Byte;
  12.  N:String;
  13.  Mode:(_None_,_NoTrace_,_UnMove_);
  14.  a,b:Integer;
  15.  xc,yc:(NoMove,Add,Sub);
  16.  
  17. Function ExtractNm(S:String):Integer;
  18. Var
  19.  N:String;
  20.  a,b:Integer;
  21. Begin
  22.  N:='';
  23.  While(I<=Length(S))and(S[I] in ['0'..'9'])do Begin
  24.   N:=N+S[I];
  25.   Inc(I);
  26.  End;
  27.  If N=''Then a:=1
  28.  Else Val(N,a,b);
  29.  ExtractNm:=a;
  30. End;
  31.  
  32. Function ExtractNmV(S:String):Integer;Begin
  33.  ExtractNmV:=ExtractNm(S)*(DrawS shr 2)
  34. End;
  35.  
  36. Procedure Line2(X,Y:Integer);Begin
  37.  If(Mode<>_NoTrace_)Then Begin
  38.   Case(xc)of
  39.    Add:Inc(X,XL);
  40.    Sub:X:=XL-X;
  41.   End;
  42.   Case(yc)of
  43.    Add:Inc(Y,YL);
  44.    Sub:Y:=YL-Y;
  45.   End;
  46.   If(YL=Y)and(X<XL)Then Begin
  47.    MoveTo(X,YL);
  48.    LineTo(XL,Y);
  49.   End
  50.    Else
  51.   Begin
  52.    MoveTo(XL,YL);
  53.    LineTo(X,Y);
  54.   End;
  55.  End;
  56. End;
  57.  
  58. Procedure SetPos(X,Y:Integer);Begin
  59.  Case(xc)of
  60.   Add:Inc(X,XL);
  61.   Sub:X:=XL-X;
  62.  End;
  63.  Case(yc)of
  64.   Add:Inc(Y,YL);
  65.   Sub:Y:=YL-Y;
  66.  End;
  67.  If(Mode<>_UnMove_)Then Begin
  68.   XL:=X;
  69.   YL:=Y;
  70.  End;
  71.  Mode:=_None_;
  72.  xc:=NoMove;
  73.  yc:=NoMove;
  74. End;
  75.  
  76. Procedure BasicDraw(S:String);Begin
  77.  I:=1;Mode:=_None_;
  78.  While I<=Length(S)do Begin
  79.   Inc(I);
  80.   Case S[I-1]of
  81.    'B':Mode:=_NoTrace_;
  82.    'C':SetColor(ExtractNm(S));
  83.    'D':Begin
  84.     a:=ExtractNmV(S);
  85.     Line2(XL,YL+a);
  86.     SetPos(XL,YL+a);
  87.    End;
  88.    'E':Begin
  89.     a:=ExtractNmV(S);
  90.     Line2(XL+a,YL-a);
  91.     SetPos(XL+a,YL-a);
  92.    End;
  93.    'F':Begin
  94.     a:=ExtractNmV(S);
  95.     Line2(XL+a,YL+a);
  96.     SetPos(XL+a,YL+a);
  97.    End;
  98.    'G':Begin
  99.     a:=ExtractNmV(S);
  100.     Line2(XL-a,YL+a);
  101.     SetPos(XL-a,YL+a);
  102.    End;
  103.    'H':Begin
  104.     a:=ExtractNmV(S);
  105.     Line2(XL-a,YL-a);
  106.     SetPos(XL-a,YL-a);
  107.    End;
  108.    'L':Begin
  109.     a:=ExtractNmV(S);
  110.     Line2(XL-a,YL);
  111.     SetPos(XL-a,YL);
  112.    End;
  113.    'M':Begin
  114.     If S[I]in['+','-']Then Begin
  115.      If S[I]='+'Then xc:=Add else xc:=Sub;
  116.      Inc(I);
  117.     End;
  118.     a:=ExtractNm(S);
  119.     If S[I]=','Then Begin
  120.      Inc(I);
  121.      If S[I]in['+','-']Then Begin
  122.       If S[I]='+'Then yc:=Add else yc:=Sub;
  123.       Inc(I);
  124.      End;
  125.      b:=ExtractNm(S);
  126.     End
  127.      Else
  128.     b:=YL;
  129.     Line2(a,b);
  130.     SetPos(a,b);
  131.    End;
  132.    'N':Mode:=_UnMove_;
  133.    'R':Begin
  134.     a:=ExtractNmV(S);
  135.     Line2(XL+a,YL);
  136.     SetPos(XL+a,YL)
  137.    End;
  138.    'U':Begin
  139.     a:=ExtractNmV(S);
  140.     Line2(XL,YL-a);
  141.     SetPos(XL,YL-a)
  142.    End;
  143.    ' ',';':;{C'est 2 caractSres ne change rien en soit, donc...pas d'arr^t!}
  144.    Else Exit;
  145.   End
  146.  End
  147. End;
  148.  
  149. Var
  150.  PiloteGraph:Integer;
  151.  ModeGraph:Integer;
  152.  
  153. BEGIN
  154.  PiloteGraph:=Detect;
  155.  ModeGraph:=Detect;
  156.  InitGraph(PiloteGraph,ModeGraph,'');
  157.  xc:=NoMove;yc:=NoMove;
  158.  BasicDraw('BM160,59M163,58M168,60M172,61M175,64M176,67M176,68M173,72 '+
  159.        'M168,75M164,76M160,77M156,75M152,73M150,72M149,68M151,63M157,59 '+
  160.        'M160,59');
  161.  BasicDraw('BM174,69M176,72M177,76M176,78M175,80M173,83M169,78M165,85 '+
  162.        'M166,85M163,86M160,87M152,85M148,86M144,85M139,85M137,83');
  163.  BasicDraw('BM150,72M148,77');
  164.  BasicDraw('BM135,83M139,84BM135,80M139,81');
  165.  BasicDraw('BM152,85M152,88M150,89M150,92');
  166.  BasicDraw('BM148,77M147,72M144,70M141,67M137,62M134,63M139,68M141,70M144,71');
  167.  BasicDraw('BM134,63M139,64BM138,62M131,66M130,64M135,59M133,59M129,61 '+
  168.        'M123,63M122,67M123,69M121,66M122,61BM118,64M117,66M120,70M122,71 '+
  169.        'M121,74M120,77M122,82M124,85M125,81M121,92M120,94M116,96M112,98 '+
  170.        'M108,100M104,102M102,104M99,107M97,111M97,114M98,116M100,120');
  171.  BasicDraw('BM100,120M102,122M104,124M108,126M112,127M116,126M120,123 '+
  172.         'M123,120M124,116M126,112M128,104M129,96M130,91M129,90M128,85M130,83 '+
  173.         'BM129,90 M134,91M136,92M141,89M144,91M146,93M142,94M148,99');
  174.  BasicDraw('BM148,99M152,95M157,93M156,91M151,92M146,93');
  175.  BasicDraw('BM144,80M146,77BM144,77M146,74M144,73BM140,78M142,77BM141,78E0 '+
  176.        'BM140,76M142,76M141,75M139,74M139,76BM137,77M135,75');
  177.  BasicDraw('BM141,75M139,72M136,71M134,71M133,72M134,73BM138,70M137,69 '+
  178.        'M138,67BM131,74M128,72M128,69M131,67M133,69M131,70M131,72M131,74');
  179.  BasicDraw('BM138,90M139,92M138,97M135,101M132,107M130,109M130,113M133,117 '+
  180.        'M136,118M142,116M144,114M148,111');
  181.  BasicDraw('BM148,99M147,103M147,106BM150,101M147,106M148,109M148,111 '+
  182.        'M152,113M155,112M153,108BM155,112M160,113M163,109M164,108BM157,93 '+
  183.        'M163,94M168,96');
  184.  BasicDraw('BM168,96M166,100M164,99M163,109M168,112M171,112M174,108M175,102 '+
  185.        'M180,98M176,95M172,93M170,93M168,96BM175,107M179,112M182,115M183,120 '+
  186.        'M182,123M181,126M180,128');
  187.  BasicDraw('BM179,98M180,101M177,102BM180,101M181,105M181,107M179,109M175,108');
  188.  BasicDraw('BM176,123M175,123M175,124M177,124M178,122');
  189.  BasicDraw('BM177,126M174,127M168,126M165,120M164,116M164,114');
  190.  BasicDraw('BM151,113M152,115M151,120M150,123');
  191.  BasicDraw('BM148,123M157,121M162,122M165,123M164,126M163,128M157,132 '+
  192.        'M172,129M177,130M180,133M176,139M167,142M160,144M146,141M144,138 '+
  193.        'M147,134M144,131M146,125M148,123');
  194.  BasicDraw('BM177,136M172,132BM176,140M172,136');
  195.  BasicDraw('BM145,128M141,126M143,123M141,125M141,120M140,125M139,120 '+
  196.        'M139,124M135,123M137,126M135,131M136,134M140,136M144,137');
  197.  BasicDraw('BM182,123M185,124M184,126M182,127M187,130M187,133M183,137 M176,139');
  198.  Repeat Until KeyPressed;
  199. END.


Voici en terminant un exemple du résultat de se petit programme :
Dernière mise à jour: Jeudi, le 29 décembre 2011