Section courante

A propos

Section administrative du site

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 QuickPascal effectuant un dessin de «Boule» dans «Boule & Bill» :

  1. Program SamplesDraw;
  2.  
  3. Uses Crt,MSGraph;
  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.  
  77. Procedure BasicDraw(S:String);Begin
  78.  I:=1;Mode:=_None_;
  79.  While I<=Length(S)do Begin
  80.   Inc(I);
  81.   Case S[I-1]of
  82.    'B':Mode:=_NoTrace_;
  83.    'C':_SetColor(ExtractNm(S));
  84.    'D':Begin
  85.     a:=ExtractNmV(S);
  86.     Line2(XL,YL+a);
  87.     SetPos(XL,YL+a);
  88.    End;
  89.    'E':Begin
  90.     a:=ExtractNmV(S);
  91.     Line2(XL+a,YL-a);
  92.     SetPos(XL+a,YL-a);
  93.    End;
  94.    'F':Begin
  95.     a:=ExtractNmV(S);
  96.     Line2(XL+a,YL+a);
  97.     SetPos(XL+a,YL+a);
  98.    End;
  99.    'G':Begin
  100.     a:=ExtractNmV(S);
  101.     Line2(XL-a,YL+a);
  102.     SetPos(XL-a,YL+a);
  103.    End;
  104.    'H':Begin
  105.     a:=ExtractNmV(S);
  106.     Line2(XL-a,YL-a);
  107.     SetPos(XL-a,YL-a);
  108.    End;
  109.    'L':Begin
  110.     a:=ExtractNmV(S);
  111.     Line2(XL-a,YL);
  112.     SetPos(XL-a,YL);
  113.    End;
  114.    'M':Begin
  115.     If S[I]in['+','-']Then Begin
  116.      If S[I]='+'Then xc:=Add else xc:=Sub;
  117.      Inc(I);
  118.     End;
  119.     a:=ExtractNm(S);
  120.     If S[I]=','Then Begin
  121.      Inc(I);
  122.      If S[I]in['+','-']Then Begin
  123.       If S[I]='+'Then yc:=Add else yc:=Sub;
  124.       Inc(I);
  125.      End;
  126.      b:=ExtractNm(S);
  127.     End
  128.      Else
  129.     b:=YL;
  130.     Line2(a,b);
  131.     SetPos(a,b);
  132.    End;
  133.    'N':Mode:=_UnMove_;
  134.    'R':Begin
  135.     a:=ExtractNmV(S);
  136.     Line2(XL+a,YL);
  137.     SetPos(XL+a,YL)
  138.    End;
  139.    'U':Begin
  140.     a:=ExtractNmV(S);
  141.     Line2(XL,YL-a);
  142.     SetPos(XL,YL-a)
  143.    End;
  144. ' ',';':;{C'est 2 caractSres ne change rien en soit, donc...pas d'arr^t!}
  145.    Else Exit;
  146.   End
  147.  End
  148. End;
  149.  
  150. Var
  151.  Err:Integer;
  152.  
  153. BEGIN
  154.  Err:=_SetVideoMode(_VRes2Color);
  155.  xc:=NoMove;yc:=NoMove;
  156.  BasicDraw('BM160,59M163,58M168,60M172,61M175,64M176,67M176,68M173,72 '+
  157.    'M168,75M164,76M160,77M156,75M152,73M150,72M149,68M151,63M157,59 '+
  158.    'M160,59');
  159.  BasicDraw('BM174,69M176,72M177,76M176,78M175,80M173,83M169,78M165,85 '+
  160.    'M166,85M163,86M160,87M152,85M148,86M144,85M139,85M137,83');
  161.  BasicDraw('BM150,72M148,77');
  162.  BasicDraw('BM135,83M139,84BM135,80M139,81');
  163.  BasicDraw('BM152,85M152,88M150,89M150,92');
  164.  BasicDraw('BM148,77M147,72M144,70M141,67M137,62M134,63M139,68M141,70M144,71');
  165.  BasicDraw('BM134,63M139,64BM138,62M131,66M130,64M135,59M133,59M129,61 '+
  166.    'M123,63M122,67M123,69M121,66M122,61BM118,64M117,66M120,70M122,71 '+
  167.    'M121,74M120,77M122,82M124,85M125,81M121,92M120,94M116,96M112,98 '+
  168.    'M108,100M104,102M102,104M99,107M97,111M97,114M98,116M100,120');
  169.  BasicDraw('BM100,120M102,122M104,124M108,126M112,127M116,126M120,123 '+
  170.     'M123,120M124,116M126,112M128,104M129,96M130,91M129,90M128,85M130,83 '+
  171.     'BM129,90 M134,91M136,92M141,89M144,91M146,93M142,94M148,99');
  172.  BasicDraw('BM148,99M152,95M157,93M156,91M151,92M146,93');
  173.  BasicDraw('BM144,80M146,77BM144,77M146,74M144,73BM140,78M142,77BM141,78E0 '+
  174.    'BM140,76M142,76M141,75M139,74M139,76BM137,77M135,75');
  175.  BasicDraw('BM141,75M139,72M136,71M134,71M133,72M134,73BM138,70M137,69 '+
  176.    'M138,67BM131,74M128,72M128,69M131,67M133,69M131,70M131,72M131,74');
  177.  BasicDraw('BM138,90M139,92M138,97M135,101M132,107M130,109M130,113M133,117 '+
  178.    'M136,118M142,116M144,114M148,111');
  179.  BasicDraw('BM148,99M147,103M147,106BM150,101M147,106M148,109M148,111 '+
  180.    'M152,113M155,112M153,108BM155,112M160,113M163,109M164,108BM157,93 '+
  181.    'M163,94M168,96');
  182.  BasicDraw('BM168,96M166,100M164,99M163,109M168,112M171,112M174,108M175,102 '+
  183.    'M180,98M176,95M172,93M170,93M168,96BM175,107M179,112M182,115M183,120 '+
  184.    'M182,123M181,126M180,128');
  185.  BasicDraw('BM179,98M180,101M177,102BM180,101M181,105M181,107M179,109M175,108');
  186.  BasicDraw('BM176,123M175,123M175,124M177,124M178,122');
  187.  BasicDraw('BM177,126M174,127M168,126M165,120M164,116M164,114');
  188.  BasicDraw('BM151,113M152,115M151,120M150,123');
  189.  BasicDraw('BM148,123M157,121M162,122M165,123M164,126M163,128M157,132 '+
  190.    'M172,129M177,130M180,133M176,139M167,142M160,144M146,141M144,138 '+
  191.    'M147,134M144,131M146,125M148,123');
  192.  BasicDraw('BM177,136M172,132BM176,140M172,136');
  193.  BasicDraw('BM145,128M141,126M143,123M141,125M141,120M140,125M139,120 '+
  194.    'M139,124M135,123M137,126M135,131M136,134M140,136M144,137');
  195.  BasicDraw('BM182,123M185,124M184,126M182,127M187,130M187,133M183,137 M176,139');
  196.  Repeat Until KeyPressed;
  197. END.

Voici en terminant un exemple du résultat de se petit programme :




Dernière mise à jour : Dimanche, le 4 mai 2014