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 Free 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 : Samedi, le 13 février 2016