home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1989 / USER1189.MSA / LISTINGS.ARC / DEMOBUBB.BSC < prev    next >
Text File  |  1989-09-03  |  4KB  |  182 lines
  1. \ BUBBLESORT DEMONSTRATION PROGRAM
  2. \ Written in FAST BASIC
  3. \ By Nigel Belcher
  4. \ Written for ST User June 1988
  5.  
  6. \ SAMPLE PROGRAM TO DEMONSTRATE THE SORTING MECHANISM USED
  7.  
  8. IF SCREENMODE=0 THEN stop=ALERT("[3][Cannot be|run in Low|Resolution][OK]",1):END
  9. yes=1
  10. no=0
  11. DIM array(20),sorted(20)
  12. HIDEMOUSE
  13. PROCfullscreen
  14. REPEAT
  15.     n=0
  16.     pass=0
  17.     comparisons=0
  18.     swaps=0
  19.     PROCinputnumbers(n)
  20.     PROCbubblesort(1,n)
  21.     PRINTTAB(40,8);"The list is now sorted"
  22.     PROCdisplaylist(1,n,n)
  23.     PRINTTAB(40,9);"Do you want to watch another sort?";
  24.     ok=-1
  25.     REPEAT
  26.         key$=GET$
  27.         IF key$="Y" OR key$="y" THEN another=yes
  28.         IF key$="N" OR key$="n" THEN another=no
  29.         UNTIL another=yes OR another=no
  30.     PRINTTAB(40,9);SPC(40);
  31.     PRINTTAB(40,8);SPC(20)
  32.     UNTIL another=no
  33. PROCrestorewindows
  34. SHOWMOUSE
  35. END
  36.  
  37.  
  38. DEFPROCinputnumbers(VAR n)
  39. LOCAL i,random,key$
  40. CLS
  41. REPEAT
  42.     INPUTTAB(0,1);"How many numbers do you want to sort (2 - 20)";n
  43.     PRINTTAB(0,1);SPC(159);
  44.     UNTIL n>=2 AND n<=20
  45. SHOWMOUSE
  46. random=ALERT("[1][Choice of numbers][Random|Your own]",1)
  47. HIDEMOUSE
  48. IF random=1 THEN
  49. \ Allocate random numbers
  50.     FOR i=1 TO n
  51.         array(i)=RND(1000)
  52.         sorted(i)=no
  53.         NEXT
  54.             ELSE
  55. \ Get user-input numbers
  56.     FOR i=1 TO n
  57.         REPEAT
  58.             PRINTTAB(0,i);SPC(70);
  59.             PRINTTAB(0,i);"Element no.";FORMAT$(i,"ZD");
  60.             INPUT array(i)
  61.             UNTIL array(i)=INT(array(i)) AND array(i)>=-99999 AND array(i)<=999999
  62.         sorted(i)=no
  63.         NEXT
  64.     ENDIF
  65. ENDPROC
  66.  
  67.  
  68.  
  69. DEFPROCfullscreen
  70. \ Various GEM routines to sort out window sizes
  71. RESERVE windowtitle%,80
  72. {windowtitle%}$="BUBBLESORT DEMONSTRATION"
  73. SETWINDTITLE OUTHANDLE,windowtitle%
  74. GETWINDCOORDS OUTHANDLE,oldscreenxbase,oldscreenybase,oldscreenwidth,oldscreenheight
  75. GETWINDFULL OUTHANDLE,fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  76. SETWINDCOORDS OUTHANDLE,fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  77. CALCWORK %11111101111,fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  78. TXTRECT fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  79. CLS
  80. IF SCREENMODE=2 THEN normal=13 ELSE large=13:normal=6
  81. TXTSIZE normal
  82. ENDPROC
  83.  
  84.  
  85.  
  86. DEFPROCbubblesort(first,last)
  87. \ The bubble sort routine
  88. LOCAL i,swapped
  89. REPEAT
  90.     pass=pass+1
  91.     swapped=no
  92.     PROCdisplaylist(first,last-pass+1,last)
  93.     FOR i=first TO last-pass
  94.         comparisons=comparisons+1
  95.         PROCshowi
  96.         IF array(i)>array(i+1) THEN PROCswapnumbers(i,i+1,swapped)
  97.         NEXT
  98.     sorted(last-pass+1)=yes
  99.     UNTIL swapped=no
  100. ENDPROC
  101.  
  102.  
  103.  
  104. DEFPROCdisplaylist(first,last,n)
  105. LOCAL i
  106. FOR i=1 TO n
  107. \ Faint those not being looked at
  108.     IF i<first OR i>last THEN TXTEFFECTS %00000010 ELSE TXTEFFECTS 0
  109.     PRINTTAB(0,i);SPC(6);FORMAT$(array(i),"sZZZZZD");
  110.     IF sorted(i)=yes THEN PRINT" sorted";SPC(18); ELSE PRINT SPC(24);
  111.     NEXT
  112. TXTEFFECTS 0
  113. ENDPROC
  114.  
  115.  
  116.  
  117. DEFPROCshowi
  118. PRINTTAB(29,i-1);"    ";
  119. PRINTTAB(29,i);"<- i";
  120. PRINTTAB(40,13);FORMAT$(comparisons,"<Comparisons    >ZZZZZD")
  121. ENDPROC
  122.  
  123.  
  124.  
  125. DEFPROCswapnumbers(a,b,VAR swapped)
  126. LOCAL x,ya,yb,key,t
  127. IF a=b THEN ENDPROC
  128. swaps=swaps+1
  129. PRINTTAB(40,15);FORMAT$(swaps,"<Swaps          >ZZZZZD")
  130. IF a>b THEN SWAP a,b
  131. \ Move numbers out
  132. FOR x=0 TO 15
  133.     IF x<=7 THEN PRINTTAB(6+x,a);FORMAT$(array(a),"XsZZZZZD");
  134.     PRINTTAB(6+x,b);FORMAT$(array(b),"XsZZZZZD");
  135.     PROCdelay
  136.     NEXT
  137. ya=a:yb=b
  138. \ Move numbers up/down
  139. REPEAT
  140.     PRINTTAB(14,ya);SPC(7);
  141.     ya=ya+1
  142.     PRINTTAB(14,ya);FORMAT$(array(a),"sZZZZZD");
  143.     PROCdelay
  144.     PRINTTAB(22,yb);SPC(7);
  145.     yb=yb-1
  146.     PRINTTAB(22,yb);FORMAT$(array(b),"sZZZZZD");
  147.     PROCdelay
  148.     UNTIL yb<=a OR ya>=b
  149. SWAP array(a),array(b)
  150. \ Move numbers in
  151. FOR x=15 TO 0 STEP -1
  152.     PRINTTAB(6+x,a);FORMAT$(array(a),"sZZZZZDX");
  153.     IF x<=7 THEN PRINTTAB(6+x,b);FORMAT$(array(b),"sZZZZZDX");
  154.     PROCdelay
  155.     NEXT
  156. swapped=yes
  157. ENDPROC
  158.  
  159.  
  160.  
  161. DEFPROCdelay
  162. LOCAL t
  163. t=TIME
  164. REPEAT
  165.     UNTIL TIME-t>30
  166. ENDPROC
  167.  
  168.  
  169.  
  170. DEFPROCrestorewindows
  171. \ Restore output window to what it was at the start
  172. GETWINDPREV OUTHANDLE,oldscreenxbase,oldscreenybase,oldscreenwidth,oldscreenheight
  173. CLS
  174. GRAB 0,0,oldscreenwidth,oldscreenheight
  175. CLOSEWIND OUTHANDLE
  176. PUT 0,0,3
  177. {windowtitle%}$="Output"
  178. SETWINDTITLE OUTHANDLE,windowtitle%
  179. OPENWIND OUTHANDLE,oldscreenxbase,oldscreenybase,oldscreenwidth,oldscreenheight
  180. ENDPROC
  181.  
  182.