home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / prpascal / colors.lzh / COLORS.PAS
Pascal/Delphi Source File  |  1987-01-04  |  18KB  |  610 lines
  1. (*
  2. *******************************************************************************
  3. TURBO PASCAL                                          by  Mike Robison
  4.                                                           OKC
  5. SECTION 1 - Screen Text and Color Manipulation
  6.             (actual progam with functions)
  7.  
  8. SECTION 2 - Use of constants to write inline statements
  9.  
  10. *******************************************************************************
  11.  
  12.  
  13.  
  14.                          *************************
  15.                          **      SECTION 1      **
  16. *******************************************************************************
  17. Screen Text and Color Manipulation
  18.  
  19. This program displays a menu of forground and background colors that you can
  20. select to see what text would look like.  There are many good screen functions
  21. and procedures used (including direct to screen writing, and flicker free
  22. control for IBM PC color monitors).
  23.  
  24. The program automatically finds out what type of system is being used and
  25. adjusts to the system -
  26.  
  27.                   Flickers?    Screen Buffer
  28. IBM JR              No            $b800
  29. IBM PC Color        Yes           $b800
  30. IBM PC Mono         No            $b000
  31.  
  32. *)
  33.  
  34. (*{$R+,U+}*)
  35.  
  36. type
  37.  screenptrtype= ^screentype;
  38.  screentype=array[0..2047] of integer; {4k = 4096 / 2 = 0..2047}
  39.  
  40.  boxtype=array[0..5] of byte;
  41.  registertype = record
  42.    ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  43.  end;
  44.  
  45.  str15 = string[15];
  46.  
  47. const
  48. linebox:boxtype=(201,205,187,186,200,188);
  49.  
  50. colornames:array[0..15] of string[8] =
  51.  (' BlacK  ','  BluE  ',' GreeN  ','  CyaN  ',
  52.   '  ReD   ','MagentA ',' BrowN  ',' LGray  ',
  53.   '  GraY  ',' LBlue  ',' LGreen ',' LCyan  ',
  54.   '  LRed  ','LMagenta',' YelloW ',' WhitE  ');
  55. frontpos = 286;
  56. backpos = 304;
  57. columns = 120;
  58. endcol = 119;
  59.  
  60.  
  61. var
  62. boxwith:boxtype;
  63. register : registertype;
  64.  
  65. display,screen,page1,page2:screenptrtype;
  66. showstart,showstop:integer;
  67. oktoshow,junior,delay : boolean;
  68. monitor:char;
  69. showlen:integer;
  70.  
  71. revinputattr,inputattr,limitattr,redonwhite,blueonwhite:integer;
  72. fillercolor,fillerascii:integer;
  73. oldcolors,lastcolors:integer;
  74.  
  75. inlinelen,inlineattr:integer;
  76. destseg,sourceseg,sourceofs,destofs:integer;
  77.  
  78. editentry : string[20];
  79.  
  80.  
  81.  
  82. {FUNCTIONS}
  83.  
  84. procedure colorit(newcolors:integer);forward;
  85.  
  86.    { Flicker control - waits for retrace signal}
  87. procedure displaywait;
  88. begin
  89.   if delay then
  90.   begin
  91.     while port[$3DA] and 8=8 do begin end;
  92.     while port[$3DA] and 8=0 do begin end;
  93.   end;
  94. end;
  95.  
  96.    { Flicker control - keeps track of scratch pad video buffer use "}
  97. procedure startandstop(start,stop:integer);
  98. begin
  99.   if delay then
  100.   begin
  101.     if start<showstart then if start>=0 then showstart:=start else showstart:=0;
  102.     if stop>showstop then if stop<=1999 then showstop:=stop else showstop:=1999;
  103.   end;
  104. end;
  105.  
  106.  
  107.    { Changes the hi bytes(ie attribute) of an array of integers }
  108. procedure reversescreen(var target; len,attribute:integer);
  109. begin
  110.   if len<=0 then exit;
  111.   destseg:=seg(target);
  112.   destofs:=ofs(target)+1;
  113.   inlinelen:=len;
  114.   inlineattr:=attribute;
  115.  
  116.   inline(
  117.     $8E/$06/destseg/
  118.     $8B/$1E/destofs/
  119.     $A1/inlineattr/
  120.     $8B/$0E/inlinelen/
  121.     $26/$88/$27/
  122.     $43/$43/
  123.     $E2/$F9);
  124. end;
  125.  
  126.    { Converts a character string into integers (attribute + char)}
  127. procedure showstr(var source,target; len,attribute:integer);
  128. begin
  129.   if len<=0 then exit;
  130.   sourceseg:=seg(source);
  131.   sourceofs:=ofs(source);
  132.   destseg:=seg(target);
  133.   destofs:=ofs(target);
  134.   inlinelen:=len;
  135.   inlineattr:=attribute;
  136.  
  137.   inline(
  138.     $1e/
  139.     $8b/$36/sourceofs/
  140.     $8b/$3e/destofs/
  141.     $8b/$16/inlineattr/
  142.     $8b/$0e/inlinelen/
  143.     $a1/sourceseg/$8e/$c0/
  144.     $a1/destseg/$8e/$d8/
  145.     $89/$d0/          {mov}
  146.     $26/$02/$04/      {es: add}
  147.     $89/$05/          {mov}
  148.     $46/$47/$47/      {inc si}
  149.     $e2/$f4/          {loop}
  150.     $1f);
  151. end;
  152.  
  153.    {Flicker control - Waits for retrace and copies integers}
  154. procedure screenwrite(var source,dest; wc:integer); {wc = count of integers}
  155. begin
  156.   if (not delay) or (wc<=0) then exit;
  157.   sourceseg:=seg(source);sourceofs:=ofs(source);
  158.   destseg:=seg(dest);destofs:=ofs(dest);
  159.   inlinelen:=wc;
  160.   inline(
  161.   $1E/             {push ds}
  162.   $8B/$0E/inlinelen/
  163.   $8E/$06/destseg/
  164.   $8B/$36/sourceofs/
  165.   $8B/$3E/destofs/
  166.   $8E/$1E/sourceseg/
  167.   $FC/              {cld}
  168.   $BA/$DA/$03/     {in al,3da}
  169.   $EC/$24/$08/     {and al,8}
  170.   $75/$FB/         {jnz}
  171.   $BA/$DA/$03/     {in al,3da}
  172.   $EC/$24/$08/     {in al,3da}
  173.   $74/$FB/         {and al}
  174.   $F3/$A5/         {rep movsw}
  175.   $1F);            {pop ds}
  176. end;
  177.  
  178.    {Sets colors(most are for color monitors), determines if flicker control used}
  179. procedure setcolor;
  180. var
  181.   stdfront:integer;
  182.   start,total,count2,count3:integer;
  183.   boxback,boxborder,boxtext:integer;
  184. begin
  185.   boxback:=$0700; boxborder:=$0400; boxtext:=$0100;
  186.   limitattr:=$0400;
  187.   stdfront:=$0f00;
  188.   inputattr:=stdfront;
  189.  
  190.   revinputattr:=(inputattr shl 4)and $7fff;
  191.   blueonwhite:=boxtext + boxback shl 4;
  192.   redonwhite:=limitattr + boxback shl 4;
  193.   fillercolor:=blueonwhite;
  194.   fillerascii:=fillercolor+197;
  195.  
  196.   if monitor in ['M','B'] then textmode(bw80) else textmode(c80);
  197.  
  198.   delay := not((monitor='M') or junior);
  199.  
  200.   if delay then   { determines how much can be written in retrace }
  201.   begin
  202.     fillchar(screen^,4000,0); total:=0;start:=1;
  203.     for count3:=1 to 5 do
  204.     begin
  205.       count2:=60; displaywait;
  206.       while (port[$3DA]and 8=8) and (count2<=2000) do
  207.       begin
  208.         count2:=count2+10;
  209.         screenwrite(screen^[start],display^[start],count2);
  210.       end;
  211.       total:=total+count2-10;
  212.     end;
  213.     showlen:=total div 5;
  214.     if showlen<75 then showlen:=75 else if showlen>2000 then showlen:=2000;
  215.     fillchar(display^,4000,$ff);
  216.   end;
  217. end;
  218.  
  219.    {Determines video buffers}
  220. procedure setup;
  221. var displaystart,count:integer;
  222. begin
  223.   delay:=false; showlen:=75;showstart:=1999;showstop:=0;
  224.  
  225. {JUNIOR?}
  226.   with register do
  227.   begin intr($11,register);junior:=(ax and 256>1);end;
  228. {MONITOR}
  229.   with register do
  230.   begin
  231.     ax:=$0f00;intr($10,register); ax:=ax and $ff;monitor:='B';
  232.     case ax of
  233.     1,3,8..15: monitor:='C';
  234.     7 : monitor:='M';
  235.     end;
  236.   end;
  237.  
  238.  {SETUP SCREEN POINTERS}
  239.   if monitor='M' then displaystart:=$b000 else displaystart:=$b800;
  240.   screen:=ptr(displaystart,0000);
  241.  
  242.   if monitor='M' then begin new(page1); display:=screen;end
  243.     else
  244.        begin
  245.          page1:=ptr(displaystart,4000);
  246.          if junior then display:=screen else new(display);
  247.        end;
  248.  
  249.   setcolor;
  250. end;
  251.  
  252.    {Flicker control - Transfers video scratch pad to screen on video retraces}
  253. procedure showscreen;
  254. label EXITLOCATION;
  255. var  stop,start,count,linelen,transferlen:integer;
  256. begin
  257.   if (not delay) or (not oktoshow) then exit;
  258.   if showstart=1999 then showstart:=0; if showstop=0 then showstop:=1999;
  259.   count:=showstart;
  260.  
  261.   repeat
  262.     display^[showstop+1]:=0;
  263.     while display^[count]=$ffff do count:=count+1; start:=count;
  264.     if start=showstop then goto EXITLOCATION;
  265.  
  266.     display^[showstop+1]:=$ffff;
  267.     while display^[count]<>$ffff do count:=count+1; stop:=count-1;
  268.  
  269.     linelen:=stop-start+1;
  270.     while linelen>0 do
  271.     begin
  272.       transferlen:=linelen;if transferlen>showlen then transferlen:=showlen;
  273.       screenwrite(display^[start],screen^[start],transferlen);
  274.       fillchar(display^[start],transferlen shl 1,255);
  275.       start:=start+transferlen;linelen:=linelen-transferlen;
  276.     end;
  277.   until count>=showstop;
  278. EXITLOCATION:
  279.   display^[showstop+1] := $ffff;
  280.   showstart:=1999;showstop:=0;
  281. end;
  282.  
  283.    {Fills area of screen with char (lo(color)) and attribute (hi(color))}
  284. procedure fillarea(x,y,x1,y1,color:integer);
  285. var count:integer;   pattern:array[0..79] of integer;
  286. begin
  287.   x:=x-1; y:=y-1; x1:=x1-1; y1:=y1-1;
  288.   if lo(color)=0 then color:=color+32;
  289.   for count:=x to x1 do pattern[count]:=color;
  290.   startandstop(y*80,y1*80+x1);
  291.   for count:=y to y1 do
  292.     move(pattern[x],display^[count*80+x],(x1-x+1)shl 1);
  293.   showscreen;
  294.   colorit(color and $ff00);
  295. end;
  296.  
  297.    {Reverses last colors used}
  298. function revcolors:integer;
  299. begin revcolors:=(lastcolors and $f000)shr 4 + (lastcolors and $0700)shl 4;end;
  300.  
  301.    {Changes attribute only (on screen)}
  302. procedure attributesb(x,y:integer; norm:boolean);
  303. var start,sbattribute:integer;
  304. begin
  305.   start:=(y-1)*80+x;
  306.   if norm then sbattribute:=lastcolors else sbattribute:=revcolors;
  307.   displaywait;reversescreen(screen^[start],17,sbattribute);
  308. end;
  309.  
  310.    {Figure out array position of cursor}
  311. function getscrpos(col,row:integer):integer;
  312. begin getscrpos:=(row-1)*80+col-1; end;
  313.  
  314.    {Makes any size of a box with a heading (optional), box is filled in}
  315. procedure makebox(lx,ly,rx,ry,boxnum:integer;description:str15);
  316. var
  317.  tmpattr,middle,linelen,top,bottom,loffset,roffset,count,count2,
  318.    attribute,len:integer;
  319. begin
  320.   linelen:=rx-lx;
  321.   top:=(ly-1)*80+lx-1; bottom:=(ry-1)*80+lx-1;
  322.  
  323.   startandstop(top,bottom+linelen+81);
  324.   if boxnum<>5 then tmpattr:=blueonwhite else tmpattr:=inputattr;
  325.   fillarea(lx+1,ly+1,rx-1,ry-1,tmpattr);
  326.  
  327.   attribute:=redonwhite;
  328.   display^[top]:=attribute+linebox[0];
  329.   display^[top+linelen]:=attribute+linebox[2];
  330.   display^[bottom]:=attribute+linebox[4];
  331.   display^[bottom+linelen]:=attribute+linebox[5];
  332.  
  333.   tmpattr:=attribute + linebox[1];
  334.   for count:=1 to  linelen-1 do
  335.   begin display^[top+count]:=tmpattr; display^[bottom+count]:=tmpattr; end;
  336.  
  337.   loffset:=top+80;roffset:=loffset+linelen;
  338.   tmpattr:=attribute + linebox[3];
  339.   for count:=1 to ry-ly-1 do
  340.   begin
  341.      display^[loffset]:=tmpattr; display^[roffset]:=tmpattr;
  342.      loffset:=loffset+80; roffset:=roffset+80;
  343.   end;
  344.  
  345.   len:=ord(description[0]);colorit(blueonwhite);
  346.   if len>0 then
  347.   begin
  348.     middle:=(lx+rx-len+1)div 2;
  349.     attribute:=blueonwhite;
  350.     showstr(description[1],display^[getscrpos(middle,ly)],len,attribute);
  351.   end;
  352.   showscreen;
  353. end;
  354.  
  355.    {Changes text colors for write procedures}
  356. procedure colorit;
  357. begin
  358.   oldcolors:=lastcolors;
  359.   if not (monitor in['B','M']) then
  360.   begin
  361.     textcolor((newcolors and $0f00) shr 8);
  362.     textbackground((newcolors and $7000) shr 12);
  363.   end
  364.     else if newcolors and $0800>0 then normvideo else lowvideo;
  365.   lastcolors:=newcolors;
  366. end;
  367.  
  368.    {Fills entire screen}
  369. procedure fillscreen;
  370. begin fillarea(1,1,80,25,fillerascii); end;
  371.  
  372.    {get front color (i.e. normal video but in color)}
  373. function getfront(color: integer):integer;
  374. begin if color=0 then getfront:= $0f00 else getfront:= color shl 8;end;
  375.  
  376.    {get color in reverse}
  377. function getback(color: integer):integer;
  378. begin if color in [0,8] then getback:= $7000 else getback:=(color and 7)shl 12;end;
  379.  
  380.    {FUNCTION WHICH MAKES AND DISPLAYS COLOR MEMU }
  381. function getnewcolor(currcolor:integer):integer;  {color in lo(currcolor) }
  382. var count,front,back,oldfront,oldback,origcolor:integer;
  383.     showsample,done,doingfront:boolean;
  384.     achar : char;
  385. begin
  386.   origcolor:=currcolor;
  387.   oktoshow := false;
  388.   makebox(41,1,80,25,4,' COLOR HELP ');
  389.   makebox(46,3,59,20,5,' FRONT COLOR');
  390.   makebox(64,3,77,12,5,' BACK COLOR ');
  391.   fillarea(42,21,79,24,currcolor shl 8);
  392.  
  393.   for count:=0 to 15 do
  394.   begin
  395.     editentry:='  '+colornames[count]+'  ';
  396.     showstr(editentry[1],display^[frontpos+count*80],12,getfront(count));
  397.     if count<=7 then
  398.       showstr(editentry[1],display^[backpos+count*80],12,getfront(count));
  399.   end;
  400.   oktoshow := true;
  401.   showscreen;
  402.  
  403.   colorit(currcolor shl 8);
  404.   gotoxy(44,21);write(#24' '#25'  =  change color');
  405.   gotoxy(44,22);write(#27' '#26'  =  change to editing front/back');
  406.   gotoxy(44,23);write(' '#17#217'  =  make selection & return');
  407.   gotoxy(44,24);write(' ESC =  escape with orig colors');
  408.   gotoxy(1,25);
  409.  
  410.   front := currcolor and $f; back := (currcolor and $f0) shr 4;
  411.   oldfront:=(front+1) and $f; oldback:=(back+1) and 7;
  412.   doingfront:=true; done:=false;
  413.  
  414.   repeat
  415.     showsample:=false;
  416.     if oldback<>back then
  417.     begin
  418.       showsample:=true;
  419.       displaywait;
  420.       reversescreen(screen^[backpos+oldback*80],12,getfront(oldback));
  421.       reversescreen(screen^[backpos+back*80],12,getback(back));
  422.       oldback:=back;
  423.     end;
  424.  
  425.     if oldfront<>front then
  426.     begin
  427.       showsample:=true;
  428.       displaywait;
  429.       reversescreen(screen^[frontpos+oldfront*80],12,getfront(oldfront));
  430.       reversescreen(screen^[frontpos+front*80],12,getback(front));
  431.       oldfront:=front;
  432.     end;
  433.  
  434.     currcolor := front shl 8 + back shl 12;
  435.  
  436.     if showsample then
  437.     begin
  438.       displaywait;
  439.          reversescreen(screen^[1641],38,currcolor);
  440.          reversescreen(screen^[1721],38,currcolor);
  441.       displaywait;
  442.          reversescreen(screen^[1801],38,currcolor);
  443.          reversescreen(screen^[1881],38,currcolor);
  444.     end;
  445.  
  446.     read(kbd,achar);
  447.  
  448.     if (achar=#27)and(keypressed) then
  449.     begin
  450.       read(kbd,achar);
  451.       case achar of
  452.       #72 :  if doingfront then {UP}
  453.                 if front=0 then front := 15 else front:=front-1
  454.                    else if back=0 then back := 7 else back:=back-1;
  455.       #75 :  doingfront:=true; {LEFT}
  456.       #77 :  doingfront:=false; {RIGHT}
  457.       end;
  458.     end
  459.        else
  460.        begin
  461.          done:= (achar = #13) or (achar = #27);
  462.          if achar=#27 then currcolor:=origcolor shl 8;
  463.          achar:=#80;
  464.        end;
  465.  
  466.     if (not done) and (achar=#80) then {DOWN}
  467.       if doingfront then front:=(front+1) and $0f else back:=(back+1) and $07;
  468.   until done;
  469.   getnewcolor := currcolor shr 8;
  470. end;
  471.  
  472. var newcolor : integer;
  473. begin
  474.   setup;
  475.   oldcolors := inputattr; lastcolors:= oldcolors;
  476.   oktoshow := true;
  477.   fillscreen;
  478.   newcolor := getnewcolor(blueonwhite shr 8);
  479. end.
  480.  
  481.  
  482.  
  483.  
  484. (*                         ********************
  485.                            ***   SECTION 2  ***
  486. *******************************************************************************
  487.                USE OF CONSTANTS TO MIMIC ASSEMBLY LANGUAGE
  488.  
  489. Below are some of the one byte assembly language instructions which can be
  490. used to write inline statements.  See examples below.
  491.  
  492. *******************************************************************************
  493. *)
  494.  
  495. const
  496.   push_es = $06;   pop_es = $07;
  497.   or_al_i = $0c;   or_ax_i = $0d; push_cs = $0e;
  498.  
  499.   push_ss = $16;   pop_ss = $17;
  500.   push_ds = $1e;   pop_ds = $1f;
  501.  
  502.   and_al_i = $24;  and_ax_i = $25;
  503.   es_ = $26;
  504.   sub_al_i = $2c;  sub_ax_i = $2d;
  505.  
  506.   xor_al_i = $34;  xor_ax_i = $35;
  507.   cmp_al_i = $3c;  cmp_ax_i = $3d;
  508.  
  509.   inc_ax =$40 ;   dec_ax = $48;   push_ax = $50;    pop_ax = $58;
  510.   inc_cx =$41 ;   dec_cx = $49;   push_cx = $51;    pop_cx = $59;
  511.   inc_dx =$42 ;   dec_dx = $4a;   push_dx = $52;    pop_dx = $5a;
  512.   inc_bx =$43 ;   dec_bx = $4b;   push_bx = $53;    pop_bx = $5b;
  513.   inc_sp =$44 ;   dec_sp = $4c;   push_sp = $54;    pop_sp = $5c;
  514.   inc_bp =$45 ;   dec_bp = $4d;   push_bp = $55;    pop_bp = $5d;
  515.   inc_si =$46 ;   dec_si = $4e;   push_si = $56;    pop_si = $5e;
  516.   inc_di =$47 ;   dec_di = $4f;   push_di = $57;    pop_di = $5f;
  517.  
  518.   jo = $70;   jno = $71;  jb = $72;  jnb = $73;  je = $74;  jne = $75;
  519.   jbe = $76;  jnbe = $77; js = $78;  jns = $79;  jp = $7a;  jnp = $7b;
  520.   jl = $7c;   jnl = $7d;  jle = $7e; jnle = $7f;
  521.  
  522.   nop = $90;
  523.   xchg_ax_cx = $91; xchg_ax_dx = $92; xchg_ax_bx = $93; xchg_ax_sp = $94;
  524.   xchg_ax_bp = $95; xchg_ax_si = $96; xchg_ax_di = $97;
  525.  
  526.   call_long = $9a;
  527.  
  528.   mov_al_m = $a0; mov_ax_m = $a1; mov_m_al = $a2;  mov_m_ax = $a3;
  529.   movsb = $a4;  movsw = $a5;
  530.   cmpsb = $a6;  cmpsw = $a7;
  531.   testb = $a8;  testw = $a9;
  532.   stosb = $aa;  stosw = $ab;
  533.   lodsb = $ac;  lodsw = $ad;
  534.   scasb = $ae;  scasw = $af;
  535.  
  536.   mov_al_i = $b0;  mov_cl_i = $b1;  mov_dl_i = $b2;  mov_bl_i = $b3;
  537.   mov_ah_i = $b4;  mov_ch_i = $b5;  mov_dh_i = $b6;  mov_bh_i = $b7;
  538.   mov_ax_i = $b8;  mov_cx_i = $b9;  mov_dx_i = $ba;  mov_bx_i = $bb;
  539.   mov_sp_i = $bc;  mov_bp_i = $bd;  mov_si_i = $be;  mov_di_i = $bf;
  540.  
  541.   ret_near = $c3;
  542.   ret_far = $cb;
  543.  
  544.   loopnz = $e0;  loopz = $e1;  loop = $e2;  jcxz = $e3;
  545.   inb = $e4; inw = $e5; outb = $e6;  outw = $e7;
  546.   call_near = $e8; jmp_near = $e9;
  547.   jmp_short = $eb;
  548.  
  549.   rep = $f2;  repz = $f3;
  550.   cld = $fc;  std = $fd;
  551.  
  552.  
  553. *******************************************************************************
  554. EXAMPLE 1 - Copy blocks of data (i.e. integers, records, etc. in an array)
  555.             Note: this is a procedure
  556. *******************************************************************************
  557.  
  558. var move_size,dest_seg, dest_ofs,   {must be in data segment, ie global}
  559.     source_seg, source_ofs : integer;
  560.  
  561. procedure repeatblock(var source_loc; size,copies:integer);
  562. begin
  563.   dest_seg := seg(source_loc);
  564.   source_ofs := ofs(source_loc);
  565.   dest_ofs := source_ofs + size;
  566.   move_size := size * copies;
  567.  
  568.   inline(
  569.     push_ds/
  570.       mov_ax_m/move_size/
  571.       xchg_ax_cx/
  572.       mov_ax_m/source_ofs/
  573.       xchg_ax_si/
  574.       mov_ax_m/dest_ofs/
  575.       xchg_ax_di/
  576.       mov_ax_m/dest_seg/
  577.       push_ax/
  578.         push_ax/
  579.         pop_ds/
  580.       pop_es/
  581.       cld/
  582.       rep/movsb/
  583.     pop_ds
  584.        );
  585. end;
  586.  
  587. *******************************************************************************
  588. EXAMPLE 2 - Nested loops
  589. *******************************************************************************
  590.  
  591. var  anumber : integer;
  592. begin
  593.   anumber := 0;
  594.   inline
  595.   (
  596.     mov_ax_m/>anumber/
  597.     mov_cx_i/>$0003/         { for count := 1 to 3 do }
  598.       push_cx/
  599.         mov_cx_i/>$0004/          { for count2 := 1 to 4 do }
  600.           inc_ax/                        { anumber := anumber + 1;}
  601.           loop/256-3/
  602.       pop_cx/
  603.       loop/256-10/
  604.     mov_m_ax/anumber
  605.   );
  606.   write(' anumber = ',anumber);
  607. end.
  608.  
  609.  
  610.