home *** CD-ROM | disk | FTP | other *** search
/ InterCD 2000 August / augusty_2000.iso / Windows-CE / Applications / basice / GRAFTEST.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-12-26  |  4.2 KB  |  240 lines
  1. loop
  2.  
  3. call clrscr
  4. print "Cursor positioning test"
  5.  
  6. loop for i%=1 to 10
  7.    call curpos(i%*2,i%)
  8.    print i%
  9.    endloop
  10.  
  11. !call pause("Press any key to continue")
  12. wait 1.5
  13.  
  14.  
  15.  
  16. call clrscr
  17. print "Testing point plot"
  18. call color(3)
  19.  
  20. loop for i%=0 to 470 step 20
  21. loop for j%=0 to 170 step 20
  22.    call point(i%,j%)
  23.    endloop
  24.    endloop
  25.  
  26. !call pause("Press any key to continue")
  27. wait 1.5
  28. print
  29.  
  30.  
  31.  
  32. call clrscr
  33. print "Testing line drawing"
  34. call color(3)
  35.  
  36. loop for i%=1 to 186 step 2
  37.    call line(0,i%,479,186-i%)
  38.    endloop
  39.  
  40. !call pause("Press any key to continue")
  41. wait 1.5
  42. print
  43.  
  44. call curpos(0,0)
  45. print "Testing rectangle fill"
  46.  
  47. call color(0)
  48. call fillrect(10,50,50,100)
  49.  
  50.  
  51.  
  52. !call pause("Press any key to continue")
  53. wait 1.5
  54. print
  55.  
  56. call clrscr
  57. print "Plot test"
  58. call gr_init
  59. call gr_setwin(50,200,1,91)
  60. call gr_setscale(0,7,-1,1)
  61.  
  62. call gr_xaxis(0,7,1,5,0,8,8)
  63. call gr_xaxis(0,7,1,5,-1,0,8)
  64. call gr_xaxis(0,7,1,5,1,8,0)
  65.  
  66. call gr_yaxis(-1,1,0.5,2,0,0,8)
  67. call gr_yaxis(-1,1,0.5,2,7,8,0)
  68.  
  69. t# = 0
  70. pen% = 0
  71. loop
  72.   while t# < 6.28
  73.   y#=sin(t#)
  74.   call gr_plot(t#,y#,pen%)
  75.   pen%=1
  76.   t# = t#+0.1
  77.   endloop
  78.  
  79. call gr_setwin(250,400,1,91)
  80. call gr_setscale(0,7,-1,1)
  81.  
  82. call gr_xaxis(0,7,1,5,0,8,8)
  83. call gr_xaxis(0,7,1,5,-1,0,8)
  84. call gr_xaxis(0,7,1,5,1,8,0)
  85.  
  86. call gr_yaxis(-1,1,0.5,2,0,0,8)
  87. call gr_yaxis(-1,1,0.5,2,7,8,0)
  88.  
  89. t# = 0
  90. pen% = 0
  91. loop
  92.   while t# < 6.28
  93.   y#=cos(t#)
  94.   call gr_plot(t#,y#,pen%)
  95.   pen%=1
  96.   t# = t#+0.1
  97.   endloop
  98.  
  99. !call pause("Press any key to continue")
  100. wait 1.5
  101. print
  102.  
  103. endloop
  104.  
  105.  
  106. procedure gr_init
  107.   gr_width# = 480
  108.   gr_height# = 188
  109.   gr_curx# = 0
  110.   gr_cury# = 0
  111.   gr_color% = 3
  112.   gr_curx% = 0
  113.   gr_cury% = 0
  114.   call gr_setwin(0,gr_width#,0,gr_height#)
  115.   call gr_setscale(0,1,0,1)
  116.   call color(gr_color%)
  117.   endproc
  118.  
  119. procedure gr_color(uu%)
  120.   gr_color% = uu%
  121.   call color(gr_color%)
  122.   endproc
  123.  
  124. procedure gr_setwin(xmin%,xmax%,ymin%,ymax%)
  125.   gr_win_xmin% = xmin%
  126.   gr_win_xmax% = xmax%
  127.   gr_win_ymin% = ymin%
  128.   gr_win_ymax% = ymax%
  129.   gr_win_width# = (xmax% - xmin%)
  130.   gr_win_height# = (ymax% - ymin%)
  131.   endproc
  132.  
  133. procedure gr_setscale(xmin#,xmax#,ymin#,ymax#)
  134.   gr_xmin# = xmin#
  135.   gr_xmax# = xmax#
  136.   gr_ymin# = ymin#
  137.   gr_ymax# = ymax#
  138.   gr_xscale# = 1.0/(xmax# - xmin#)
  139.   gr_yscale# = 1.0/(ymax# - ymin#)
  140.   endproc
  141.  
  142. procedure gr_scalex(x#)
  143.   gr_ux% = (x#-gr_xmin#) * gr_xscale# * gr_win_width# + gr_win_xmin%
  144.   return (gr_ux%)
  145.   endproc
  146.  
  147. procedure gr_scaley(y#)
  148.   gr_uy% = gr_height# - ((y#-gr_ymin#) * gr_yscale# * gr_win_height# + gr_win_ymin%)
  149.   return (gr_uy%)
  150.   endproc
  151.  
  152. procedure gr_plot(x#,y#,pen%)
  153.   gr_ux% = gr_scalex(x#)
  154.   gr_uy% = gr_scaley(y#)
  155.   if pen% then
  156.     call line(gr_curx%,gr_cury%,gr_ux%,gr_uy%)
  157.   endif
  158.   gr_curx# = x#
  159.   gr_curx% = gr_ux%
  160.   gr_cury# = y#
  161.   gr_cury% = gr_uy%
  162.   endproc
  163.  
  164. procedure gr_point(x#,y#)
  165.   gr_ux% = gr_scalex(x#)
  166.   gr_uy% = gr_scaley(y#)
  167.   call point(gr_ux%,gr_uy%)
  168.   gr_curx# = x#
  169.   gr_curx% = gr_ux%
  170.   gr_cury# = y#
  171.   gr_cury% = gr_uy%
  172.   endproc
  173.  
  174. procedure gr_clrwin
  175.   call fillrect(gr_win_xmin%,gr_win_ymin%,gr_win_xmax%,gr_win_ymax%)
  176.   endproc
  177.  
  178. procedure gr_xaxis(min#,max#,tick#,minticks%,pos#,below%,above%)
  179.   utmp# = tick#/minticks%
  180.   ux# = min#
  181.   up% = 0
  182.   u1% = below%/2
  183.   u2% = above%/2
  184.   tickcnt% = 0
  185.   loop
  186.  
  187.     call gr_plot(ux#,pos#,up%)
  188.     up%=1
  189.  
  190.     if tickcnt% = 0 then
  191.       call line(gr_curx%,gr_cury%-above%,gr_curx%,gr_cury%+below%)
  192.       else
  193.       call line(gr_curx%,gr_cury%-u2%,gr_curx%,gr_cury%+u1%)
  194.       endif
  195.  
  196.     ux#=ux#+utmp#
  197.  
  198.     tickcnt% = tickcnt%+1
  199.     if tickcnt% = minticks% then
  200.        tickcnt% = 0
  201.        endif
  202.  
  203.     while ux# < (max# + utmp#/2)
  204.  
  205.     endloop
  206.  
  207.   endproc
  208.  
  209. procedure gr_yaxis(min#,max#,tick#,minticks%,pos#,left%,right%)
  210.   utmp# = tick#/minticks%
  211.   uy# = min#
  212.   up% = 0
  213.   u1% = left%/2
  214.   u2% = right%/2
  215.   tickcnt% = 0
  216.   loop
  217.  
  218.     call gr_plot(pos#,uy#,up%)
  219.     up%=1
  220.  
  221.     if tickcnt% = 0 then
  222.       call line(gr_curx%-left%,gr_cury%,gr_curx%+right%,gr_cury%)
  223.       else
  224.       call line(gr_curx%-u1%,gr_cury%,gr_curx%+u2%,gr_cury%)
  225.       endif
  226.  
  227.     uy#=uy#+utmp#
  228.  
  229.     tickcnt% = tickcnt%+1
  230.     if tickcnt% = minticks% then
  231.        tickcnt% = 0
  232.        endif
  233.  
  234.     while uy# < (max# + utmp#/2)
  235.  
  236.     endloop
  237.  
  238.   endproc
  239.  
  240.