home *** CD-ROM | disk | FTP | other *** search
/ GFX Sensations 1 / Graphic Sensations - Volume 1.iso / tools / amiga / misc / visual.lha / VisualSort / VisualSort.e < prev    next >
Encoding:
Text File  |  1993-09-29  |  20.6 KB  |  553 lines
  1. /*
  2. *****************************************************************
  3. *       --- VisualSort V1.01 (C) 1994 by Nico Max ---           *
  4. *                                                               *
  5. * This  program is public domain. This means that you can copy  *
  6. * it  for free or rewrite the source for your purposes as long  *
  7. * as  you  give  with  your  program  a note about the origial  *
  8. * aothor.                                                       *
  9. *                                                               *
  10. * the author can be reached at: Nico Max                        *
  11. *                               Gerüstbauerring 15              *
  12. *                               18109 Rostock                   *
  13. *                               Germany                         *
  14. *               or email to: sanity@informatik.uni-rostock.de   *
  15. *                                                               *
  16. * VisualSort was written using...                               *
  17. *                                                               *
  18. *    Wouter van Oortmerssen's Amiga_EV2.1b   (I love it!)       *
  19. *****************************************************************
  20. */
  21.  
  22. MODULE 'intuition/screens','intuition/intuition','intuition/gadgetclass',
  23.        'graphics/displayinfo','graphics/text','graphics/rastport',
  24.        'gadtools','libraries/gadtools',
  25.        'reqtools','libraries/reqtools',
  26.        'devices/inputevent','keymap'
  27.  
  28. OPT OSVERSION=37
  29.  
  30. CONST COLSET=2,COLCLEAR=0
  31.  
  32. ENUM NOWB,NOSCR,NOWIN,NOID,NOVISUAL,NOCONTXT,NOGAD,NOMENUS,SCHLEIF
  33. ENUM ARG_AS,ARG_DES,ARG_DEGREE,NUMARGS
  34. ENUM ABOUT,QUIT,BUBBLE,SHAKE,INSERT,SEL,SHELL,MERGE,QUICK,HEAP,SCREEN,BREAK,STOPS
  35.  
  36. RAISE NOWB     IF OpenWorkBench()=0,
  37.       NOID     IF GetVPModeID()=INVALID_ID,
  38.       NOSCR    IF OpenScreenTagList()=0,
  39.       NOWIN    IF OpenWindowTagList()=0,
  40.       NOVISUAL IF GetVisualInfoA()=0,
  41.       NOCONTXT IF CreateContext()=0,
  42.       NOGAD    IF CreateGadgetA()=0,
  43.       NOMENUS  IF CreateMenusA()=0,
  44.       NOMENUS  IF LayoutMenusA()=0
  45.  
  46. DEF scr=0:PTR TO screen,win=0:PTR TO window,visual=0,menus,
  47.     glist=0:PTR TO gadget,
  48.     scroller:PTR TO gadget, bstop:PTR TO gadget,bexit:PTR TO gadget,
  49.     infoy,infox,inforecty,
  50.     reqfail=FALSE,
  51.     screenmodereq:PTR TO rtscreenmoderequester,
  52.     adr=0:PTR TO INT,maxlen,
  53.     rectop,recleft,recwidth,
  54.     font=0,textheight,
  55.     args[NUMARGS]:LIST,shortcuts:PTR TO LONG,sorties:PTR TO LONG
  56.  
  57. PROC main() HANDLE
  58. DEF x:PTR TO LONG,templ,rdargs
  59.   shortcuts:= ['?','Q','B','A','I','C','L','M','K','H','S','E','O']
  60.   sorties:= [BUBBLE,SHAKE,INSERT,SEL,SHELL,MERGE,QUICK,HEAP]
  61.   FOR x:=0 TO NUMARGS-1 DO args[x]:=0
  62.   templ:='A=ASCENDING/S,D=DESCENDING/S,DEGREE/N'; rdargs:=ReadArgs(templ,args,NIL)
  63.   IF (args[ARG_AS]<>0) AND (args[ARG_DES]<>0)
  64.     WriteF('decide what you want\n'); Raise(SCHLEIF); ENDIF
  65.   IF ((x:=Long(args[ARG_DEGREE]))<0) OR (x>100)
  66.     WriteF('0 <= degree <= 100\n'); Raise(SCHLEIF); ENDIF
  67.   IF ((args[ARG_AS]=0) AND (args[ARG_DES]=0)) AND args[ARG_DEGREE]
  68.     WriteF('choose ascending/descending\n'); Raise(SCHLEIF); ENDIF
  69.   IF ((args[ARG_AS] OR args[ARG_DES]) AND (args[ARG_DEGREE]=0))
  70.     WriteF('choose a degree\n'); Raise(SCHLEIF); ENDIF
  71.   openlibs(); opengui(0,'Welcome to VisualSort V1.0')
  72.   wait4message(); closegui(); closelibs(); IF rdargs THEN FreeArgs(rdargs)
  73. EXCEPT
  74.   x:= ['open workbench screen','open screen','open window','get ModeID',
  75.        'get visualinfo','get context','create gadget','create menus']
  76.   IF exception <> SCHLEIF THEN printerrmsg('Couldn\at \s!',[x[exception]])
  77.   closegui(); closelibs(); IF rdargs THEN FreeArgs(rdargs)
  78. ENDPROC
  79.  
  80. PROC wait4message()
  81. DEF mes:PTR TO intuimessage,class,code,iadr,qual,what,funcs:PTR TO LONG
  82.   LOOP
  83.     IF mes:=Gt_GetIMsg(win.userport)
  84.       class:=mes.class; code :=mes.code; iadr :=mes.iaddress; qual:= mes.qualifier
  85.       Gt_ReplyIMsg(mes); what:= getwhat(iadr,class,code,qual)
  86.       SELECT what
  87.         CASE ABOUT
  88.           printerrmsg('                   --- VisualSort 1.01 ---\n'+
  89.              '               (C) Copyright 1994 by Nico Max\n\n'+
  90.              'for remarks or if you find bugs (or for sending donations :-))\n'+
  91.              'please write to:   Nico Max\n'+
  92.              '                   Gerüstbauerring 15\n'+
  93.              '                   18109 Rostock\n'+
  94.              '                   Germany\n'+
  95.              '       or email:   sanity@informatik.uni-rostock.de\n\n'+
  96.              '   Written using Wouter van Oortmerssen\as Amiga_EV2.1b\n'+
  97.              '   GUI created using GadToolsBoxV2.0c (C) Jaba Development',0)
  98.         CASE QUIT; RETURN
  99.         CASE SCREEN
  100.           IF (reqtoolsbase=0) OR (screenmodereq=0)
  101.             PrintFault('No reqtools.library available!',0)
  102.           ELSE
  103.             IF RtScreenModeRequestA(screenmodereq,'Choose screenmode...',
  104.                 [RT_WINDOW,win,
  105.                  RT_REQPOS,REQPOS_CENTERWIN,0])
  106.                closegui(); opengui(screenmodereq.displayid,'nice screenmode :-)')
  107.             ENDIF
  108.           ENDIF
  109.         DEFAULT
  110.           IF (what >= BUBBLE) AND (what <= HEAP)
  111.             OnGadget(bexit,win,0); OnGadget(bstop,win,0); createarray()
  112.             IF adr
  113.               clearinfo(); ClearMenuStrip(win)
  114.               funcs:= [`bubble(0,maxlen,adr),`shake  (0,maxlen,adr),
  115.                        `insert(0,maxlen,adr),`selsort(0,maxlen,adr),
  116.                        `shell (0,maxlen,adr),`merge  (0,maxlen,adr),
  117.                        `quick (0,maxlen,adr),`heap   (1,maxlen,adr)]
  118.               Eval(funcs[what-BUBBLE]); ResetMenuStrip(win,menus); DisplayBeep(0)
  119.             ELSE
  120.               printerrmsg('Not enough memory!\nYou should use a lower resolution',0)
  121.             ENDIF
  122.             OffGadget(bexit,win,0); OffGadget(bstop,win,0)
  123.           ENDIF
  124.       ENDSELECT
  125.     ELSE; WaitPort(win.userport); ENDIF
  126.   ENDLOOP
  127. ENDPROC
  128.  
  129. PROC checkbreak()
  130. DEF mes:PTR TO intuimessage,iadr,class,code,qual,weiter=FALSE,what
  131.   IF mes:=Gt_GetIMsg(win.userport)
  132.     iadr :=mes.iaddress; class:= mes.class; code:= mes.code; qual:= mes.qualifier
  133.     Gt_ReplyIMsg(mes); what:= getwhat(iadr,class,code,qual)
  134.     SELECT what
  135.       CASE STOPS
  136.         clearinfo();  displayinfo(' *** stopped',0)
  137.         REPEAT
  138.           IF mes:=Gt_GetIMsg(win.userport)
  139.             iadr :=mes.iaddress; class:= mes.class; code:= mes.code; qual:= mes.qualifier
  140.             Gt_ReplyIMsg(mes); what:= getwhat(iadr,class,code,qual)
  141.             IF what=STOPS THEN weiter:= TRUE
  142.             IF what=BREAK
  143.               what:= RemoveGadget(win,bstop)
  144.               bstop.flags:= bstop.flags AND Not(GFLG_SELECTED);
  145.               AddGadget(win,bstop,what); RefreshGList(bstop,win,0,1)
  146.               clearinfo(); displayinfo(' Brekkies',0); Raise(BREAK); ENDIF
  147.           ELSE; WaitPort(win.userport); ENDIF
  148.         UNTIL weiter; clearinfo()
  149.       CASE BREAK
  150.         clearinfo(); displayinfo(' Brekkies',0); Raise(BREAK)
  151.     ENDSELECT
  152.   ENDIF
  153. ENDPROC
  154.  
  155. PROC getwhat(iadr,class,code,qual)
  156. DEF inputrec:inputevent,buffer[10]:STRING,x,titel,item
  157.     inputrec.class:= IECLASS_RAWKEY; inputrec.code:= code; inputrec.qualifier:= qual
  158.     IF class=IDCMP_RAWKEY
  159.       MapRawKey(inputrec,buffer,10,0)
  160.       IF inputrec.qualifier AND IEQUALIFIER_RCOMMAND
  161.         UpperStr(buffer); x:= buffer[]
  162.         SELECT x
  163.           CASE Char(shortcuts[ABOUT]);  RETURN ABOUT
  164.           CASE Char(shortcuts[QUIT]);   RETURN QUIT
  165.           CASE Char(shortcuts[BUBBLE]); RETURN BUBBLE
  166.           CASE Char(shortcuts[SHAKE]);  RETURN SHAKE
  167.           CASE Char(shortcuts[INSERT]); RETURN INSERT
  168.           CASE Char(shortcuts[SEL]);    RETURN SEL
  169.           CASE Char(shortcuts[SHELL]);  RETURN SHELL
  170.           CASE Char(shortcuts[MERGE]);  RETURN MERGE
  171.           CASE Char(shortcuts[QUICK]);  RETURN QUICK
  172.           CASE Char(shortcuts[HEAP]);   RETURN HEAP
  173.           CASE Char(shortcuts[SCREEN]); RETURN SCREEN
  174.           CASE Char(shortcuts[BREAK])
  175.             IF bexit.flags AND GFLG_DISABLED THEN RETURN -1
  176.             x:= RemoveGadget(win,bexit); bexit.flags:= bexit.flags+GFLG_SELECTED
  177.             AddGadget(win,bexit,x); RefreshGList(bexit,win,0,1)
  178.             Delay(4); x:= RemoveGadget(win,bexit)
  179.             bexit.flags:= bexit.flags-GFLG_SELECTED; AddGadget(win,bexit,x)
  180.             RefreshGList(bexit,win,0,1); RETURN BREAK
  181.           CASE Char(shortcuts[STOPS])
  182.             IF bexit.flags AND GFLG_DISABLED THEN RETURN -1
  183.             x:= RemoveGadget(win,bstop); bstop.flags:= Eor(bstop.flags,GFLG_SELECTED);
  184.             AddGadget(win,bstop,x); RefreshGList(bstop,win,0,1); RETURN STOPS
  185.         ENDSELECT
  186.       ENDIF
  187.     ELSE
  188.       IF iadr=bstop THEN RETURN STOPS
  189.       IF iadr=bexit THEN RETURN BREAK; ENDIF
  190.     IF (class=IDCMP_MENUPICK) AND (code<>$ffff)
  191.       titel:=code AND %11111; item:= Shr(code,5) AND %111111
  192.       SELECT titel
  193.         CASE 0; IF item=0 THEN RETURN ABOUT; IF item=2 THEN RETURN QUIT
  194.         CASE 1; RETURN sorties[item]
  195.         CASE 2; RETURN SCREEN
  196.       ENDSELECT
  197.     ENDIF
  198. ENDPROC -1
  199.  
  200. /*-----------------------------------------------------------------------------*/
  201. PROC bubble(von,bis,adr:PTR TO INT) HANDLE
  202. DEF fertig, pos,loop=1
  203.   REPEAT
  204.     fertig:= TRUE; displayinfo('\d[5]th loop  ',[loop++])
  205.     FOR pos:= von TO bis-1
  206.       IF adr[pos] > adr[pos+1]
  207.         swapentries (adr,pos,pos+1); fertig:=FALSE
  208.       ENDIF
  209.     ENDFOR
  210.     checkbreak()
  211.   UNTIL fertig
  212. EXCEPT
  213. ENDPROC
  214. /*-----------------------------------------------------------------------------*/
  215. PROC shake (von,bis,adr:PTR TO INT) HANDLE
  216. DEF links, rechts, i, position,loop=1
  217.   position:= links:= von; rechts:= bis - 1
  218.   WHILE links <= rechts
  219.     displayinfo('\d[5] left, \d[5] right, \d[5]th loop   ',[links,rechts,loop++])
  220.     FOR i := links TO rechts
  221.       checkbreak()
  222.       IF adr[i] > adr[i+1] THEN swapentries (adr,i,position:=i+1)
  223.     ENDFOR
  224.     rechts := position - 1
  225.     FOR i:= rechts TO links STEP -1
  226.       checkbreak()
  227.       IF adr[i] > adr[i+1] THEN swapentries (adr,position:=i,i+1)
  228.     ENDFOR
  229.     links := position + 1
  230.   ENDWHILE
  231. EXCEPT
  232. ENDPROC
  233. /*-----------------------------------------------------------------------------*/
  234. PROC insert(von,bis,adr:PTR TO INT) HANDLE
  235. DEF j,i
  236.   FOR i:= von+1 TO bis
  237.     checkbreak()
  238.     FOR j:= i TO 2 STEP -1 DO IF adr[j-1] > adr [j] THEN swapentries (adr,j-1,j)
  239.     displayinfo('\d[5]th element at right position',{i})
  240.   ENDFOR
  241. EXCEPT
  242. ENDPROC
  243. /*-----------------------------------------------------------------------------*/
  244. PROC selsort(von,bis,adr:PTR TO INT) HANDLE
  245. DEF min,x,y
  246.   FOR y:= von TO bis-1
  247.     min:=y; checkbreak()
  248.     FOR x:=y+1 TO bis
  249.       IF adr[x] < adr[min] THEN min:=x
  250.     ENDFOR
  251.     swapentries (adr,y,min); displayinfo('\d[5]th element at right position  ',[y])
  252.   ENDFOR
  253. EXCEPT
  254. ENDPROC
  255. /*-----------------------------------------------------------------------------*/
  256. PROC shell(von,bis,adr:PTR TO INT) HANDLE
  257. DEF i,j,incr
  258.   incr:= Shr(bis,1)
  259.   WHILE incr>von
  260.     FOR i:= incr+1 TO bis
  261.       j:= i-incr
  262.       WHILE j>0
  263.         checkbreak()
  264.         IF adr[j] > adr[j+incr]
  265.           swapentries (adr,j,j+incr); j:= j-incr
  266.         ELSE; j:= 0; ENDIF
  267.       ENDWHILE
  268.     ENDFOR
  269.     incr:= Shr(incr,1)
  270.   ENDWHILE
  271. EXCEPT
  272. ENDPROC
  273. /*-----------------------------------------------------------------------------*/
  274. PROC merge (von,bis,adr:PTR TO INT) HANDLE
  275. DEF hilf:PTR TO INT
  276.   hilf:= New(Shl(bis-von+2,1))
  277.   IF hilf; sort1 (adr, von, bis, hilf); Dispose(hilf)
  278.   ELSE;    printerrmsg('Not enough memory!\nChoose a lower screenmode!',0); ENDIF
  279. EXCEPT
  280. ENDPROC
  281.  
  282. PROC mergesort1 (inp:PTR TO INT,von1, bis1,von2,bis2,out:PTR TO INT)
  283. DEF i1, i2, j
  284.   j:= i1 := von1; i2 := von2; checkbreak()
  285.   WHILE (i1 <= bis1) AND (i2 <= bis2)
  286.     checkbreak()
  287.     IF inp[i1] <= inp[i2]
  288.       setpoint(i1,inp[i1],COLCLEAR); setpoint(j,inp[i1],COLSET)
  289.       out[j++] := inp[i1++]
  290.     ELSE
  291.       setpoint(i2,inp[i2],COLCLEAR); setpoint(j,inp[i2],COLSET)
  292.       out[j++] := inp[i2++]
  293.     ENDIF
  294.   ENDWHILE
  295.   WHILE i1 <= bis1
  296.     checkbreak()
  297.     setpoint(i1,inp[i1],COLCLEAR); setpoint(j,inp[i1],COLSET)
  298.     out[j++] := inp[i1++]
  299.   ENDWHILE
  300.   WHILE i2 <= bis2
  301.     checkbreak()
  302.     setpoint(i2,inp[i2],COLCLEAR); setpoint(j,inp[i2],COLSET)
  303.     out[j++] := inp[i2++]
  304.   ENDWHILE
  305. ENDPROC
  306.  
  307. PROC sort1 (unsort_vekt:PTR TO INT,von,bis,hilf:PTR TO INT)
  308. DEF split, x1, x2,i
  309.   IF (bis-von) > 0
  310.     split := Shr((bis-von),1); x1 := von + split; x2 := x1 + 1
  311.     sort2 (unsort_vekt, von, x1, hilf)
  312.     sort2 (unsort_vekt, x2, bis, hilf)
  313.     mergesort1 (unsort_vekt, von, x1, x2, bis, hilf)
  314.     FOR i:= von TO bis
  315.       checkbreak(); unsort_vekt[i]:= hilf[i]
  316.     ENDFOR
  317.   ELSE; hilf[von] := unsort_vekt[von]; ENDIF
  318. ENDPROC
  319.  
  320. PROC sort2 (unsort_vekt:PTR TO INT,von, bis,hilf:PTR TO INT)
  321. DEF split, x1, x2
  322.   IF (bis-von) > 0
  323.     split := Shr((bis-von),1); x1 := von + split; x2 := x1 + 1
  324.     sort1 (unsort_vekt, von, x1, hilf)
  325.     sort1 (unsort_vekt, x2, bis, hilf)
  326.     mergesort1 (hilf, von, x1, x2, bis, unsort_vekt)
  327.   ENDIF
  328. ENDPROC
  329. /*-----------------------------------------------------------------------------*/
  330. PROC quick(von,bis,adr:PTR TO INT) HANDLE
  331.   qsort(von,bis,adr)
  332. EXCEPT
  333. ENDPROC
  334.  
  335. PROC qsort(l, r, a:PTR TO INT)
  336. DEF i, j, x
  337.   i := l; j := r; x := a[Shr((l+r),1)]
  338.   REPEAT
  339.     checkbreak()
  340.     WHILE a[i++] < x; ENDWHILE
  341.     WHILE x < a[j] DO DEC j
  342.     IF i-- <= j; swapentries(a,i++,j); DEC j; ENDIF
  343.   UNTIL i > j
  344.   IF l < j THEN qsort(l, j,a)
  345.   IF i < r THEN qsort(i, r,a)
  346. ENDPROC
  347. /*-----------------------------------------------------------------------------*/
  348. PROC heap(von,bis,adr:PTR TO INT) HANDLE
  349. DEF i,x
  350.   x:= Shr(bis,1)
  351.   FOR i:= x TO von STEP -1
  352.     checkbreak(); reheap (i,bis,adr)
  353.   ENDFOR
  354.   FOR i:= bis TO von+1 STEP -1
  355.     checkbreak(); swapentries (adr,von,i); reheap (von,i-1,adr)
  356.   ENDFOR
  357. EXCEPT
  358. ENDPROC
  359.  
  360. PROC reheap (i,k,adr:PTR TO INT)
  361. DEF j,son,x
  362.   j:= i
  363.   LOOP
  364.     checkbreak()
  365.     IF (x:=Shl(j,1))  > k THEN RETURN
  366.     IF (x+1)         <= k
  367.       IF adr[x] >= adr[x+1] THEN son:= x ELSE son:= x+1
  368.     ELSE; son:= x; ENDIF
  369.     IF adr[j] <= adr[son]
  370.       swapentries (adr,j,son); j:= son
  371.     ELSE; RETURN; ENDIF
  372.   ENDLOOP
  373. ENDPROC
  374. /*-----------------------------------------------------------------------------*/
  375.  
  376. PROC swapentries(adr:PTR TO INT,i,j)
  377. DEF x
  378.   setpoint(i,adr[i],COLCLEAR); setpoint(j,adr[j],COLCLEAR)
  379.   setpoint(i,adr[j],COLSET); setpoint(j,adr[i],COLSET)
  380.   x:= adr[i]; adr[i]:= adr[j]; adr[j]:=x
  381. ENDPROC
  382.  
  383. PROC createarray()
  384. DEF x,anstieg,rndadr:PTR TO INT,y,a,b,rndptr,temp
  385.   IF adr THEN Dispose(adr); adr:= New(Shl(maxlen+1,1))
  386.   IF adr
  387.     displayinfo('Creating sorting area...',0)
  388.     SetAPen(win.rport,0); RectFill(win.rport,recleft-1,rectop-1,maxlen+1,recwidth+rectop+1)
  389.     IF args[ARG_DEGREE]
  390.       anstieg:= SpDiv(SpFlt(maxlen),SpFlt(recwidth))
  391.       IF args[ARG_DES]
  392.         FOR x:= 0 TO maxlen
  393.           adr[x]:= SpFix(SpMul(SpFlt(maxlen+1-x),anstieg)); setpoint(x,adr[x],1)
  394.         ENDFOR
  395.       ELSE
  396.         FOR x:= 0 TO maxlen
  397.           adr[x]:= SpFix(SpMul(SpFlt(x),anstieg)); setpoint(x,adr[x],1)
  398.         ENDFOR
  399.       ENDIF
  400.       rndadr:= New(Shl(maxlen+1,1))
  401.       IF rndadr
  402.         x:= Long(args[ARG_DEGREE])
  403.         y:= SpFix(SpMul(SpDiv(100.0,SpFlt(-maxlen)),SpFlt(x)))+maxlen
  404.         FOR x:=0 TO maxlen DO rndadr[x]:= 65535
  405.         IF y<>1
  406.           FOR x:=0 TO y
  407.             rndptr:= a:= Rnd(maxlen)+1; b:= Rnd(maxlen)+1
  408.             WHILE (rndadr[rndptr] <> 65535) AND (rndadr[rndptr] = a)
  409.               INC rndptr; IF rndptr > maxlen THEN rndptr:= 0
  410.             ENDWHILE
  411.             rndadr[rndptr]:= a; a:= rndptr; rndptr:= b;
  412.             WHILE (rndadr[rndptr] <> 65535) AND (rndadr[rndptr] = b)
  413.               INC rndptr; IF rndptr > maxlen THEN rndptr:= 0;
  414.             ENDWHILE
  415.             rndadr[rndptr]:= b; b:= rndptr
  416.             setpoint(a,adr[a],COLCLEAR); setpoint(b,adr[b],COLCLEAR)
  417.             temp:= adr[a]; adr[a]:= adr[b]; adr[b]:= temp
  418.             setpoint(a,adr[a],1); setpoint(b,adr[b],1)
  419.           ENDFOR
  420.         ENDIF
  421.         Dispose(rndadr)
  422.       ELSE
  423.         printerrmsg('Not enough memory!\nChoose a lower resolution!\n',0)
  424.         SetAPen(win.rport,0); RectFill(win.rport,recleft,rectop,maxlen,recwidth+rectop)
  425.         FOR x:=0 TO maxlen
  426.           adr[x]:= Rnd(recwidth); setpoint(x,adr[x],1)
  427.         ENDFOR
  428.       ENDIF
  429.     ELSE
  430.       FOR x:=0 TO maxlen
  431.         adr[x]:= Rnd(recwidth); setpoint(x,adr[x],1)
  432.       ENDFOR
  433.     ENDIF
  434.   ENDIF
  435. ENDPROC
  436.  
  437. PROC clearinfo()
  438.   SetAPen(win.rport,0); RectFill(win.rport,2,inforecty,scr.width-2,inforecty+textheight+1)
  439. ENDPROC
  440.  
  441. PROC displayinfo(body,text)
  442. DEF x,ziel[40]:STRING
  443.   SetAPen(win.rport,1); LEA.L putproc(PC),A0; MOVE.L A0,x
  444.   RawDoFmt(body,text,x,ziel); TextF(infox,infoy,ziel)
  445. ENDPROC
  446.  
  447. putproc: MOVE.B D0,(A3)+; RTS
  448.  
  449. PROC setpoint(x,y,c); Plot(recleft+x,rectop+recwidth-y,c); ENDPROC
  450.  
  451. PROC opengui(modeid,welcome)
  452. DEF wbscr=0:PTR TO screen,x,offy,delta,
  453.     twidth, icht:PTR TO tf,ichr:PTR TO rastport
  454.     IF modeid=0
  455.       IF wbscr:= OpenWorkBench()
  456.         modeid:= GetVPModeID(wbscr.viewport); font:= wbscr.font; ENDIF
  457.     ENDIF
  458.   scr:=OpenScreenTagList(0,
  459.         [SA_TITLE,     'VisualSortV1.01 ©1994 by Nico Max',
  460.          SA_PENS,       [$ffff]:INT,
  461.          SA_FONT,       font,
  462.          SA_FULLPALETTE,TRUE,
  463.          SA_DEPTH,      2,
  464.          SA_DISPLAYID,  modeid,
  465.          SA_TYPE,       CUSTOMSCREEN,0])
  466.   visual:=GetVisualInfoA(scr,NIL)
  467.   LayoutMenusA(menus:=CreateMenusA([1,0,'Project',0,$0,0,0,
  468.                         2,0,'About...',shortcuts[ABOUT],$0,0,0,
  469.                         2,0,-1,0,$0,0,0,
  470.                         2,0,'Quit',      shortcuts[QUIT],$0,0,0,
  471.                         1,0,'Algorithms',0,$0,0,0,
  472.                         2,0,'BubbleSort',shortcuts[BUBBLE],$0,0,0,
  473.                         2,0,'ShakeSort', shortcuts[SHAKE],$0,0,0,
  474.                         2,0,'InsertSort',shortcuts[INSERT],$0,0,0,
  475.                         2,0,'SelectSort',shortcuts[SEL],$0,0,0,
  476.                         2,0,'ShellSort', shortcuts[SHELL],$0,0,0,
  477.                         2,0,'MergeSort', shortcuts[MERGE],$0,0,0,
  478.                         2,0,'QuickSort', shortcuts[QUICK],$0,0,0,
  479.                         2,0,'HeapSort',  shortcuts[HEAP],$0,0,0,
  480.                         1,0,'Setup',0,$0,0,0,
  481.                         2,0,IF reqfail THEN 'sorry, no reqtools' ELSE 'Screenmode...',shortcuts[SCREEN],$0,0,0,
  482.                         0,0,0,0,0,0,0]:newmenu,NIL),visual,[$80080043,1,0])
  483.   delta:= twidth:= TextLength(ichr:= scr.rastport,'  Stop  ',STRLEN)
  484.   icht:= ichr.font; textheight:= icht.ysize; offy:= scr.height-(textheight+6)
  485.   bstop:= CreateGadgetA(BUTTON_KIND,CreateContext({glist}),
  486.     [scr.width-twidth,offy,twidth,textheight+6,'  St_op  ',NIL,0,16,visual,0]:newgadget,
  487.     [GA_DISABLED,TRUE,GT_UNDERSCORE,"_",0])
  488.   bstop.activation:= bstop.activation OR GACT_TOGGLESELECT
  489.   twidth:= TextLength(ichr,'  Break  ',STRLEN); delta:= delta+twidth
  490.   bexit:=CreateGadgetA(BUTTON_KIND,bstop,
  491.     [scr.width-delta,offy,twidth,textheight+6,'  Br_eak  ',NIL,1,16,visual,0]:newgadget,
  492.     [GA_DISABLED,TRUE,GT_UNDERSCORE,"_",0])
  493.   scroller:=CreateGadgetA(SCROLLER_KIND,bexit,
  494.     [0,offy,scr.width-delta,textheight+6,0,NIL,2,0,visual,0]:newgadget,
  495.     [GA_RELVERIFY,1,
  496.      GTSC_TOTAL,128,
  497.      GTSC_VISIBLE,1,
  498.      GA_DISABLED,1,NIL])
  499.   win:=OpenWindowTagList(0,
  500.         [WA_FLAGS,       WFLG_ACTIVATE+WFLG_SMART_REFRESH+WFLG_BACKDROP+
  501.                          WFLG_BORDERLESS+$200000,
  502.          WA_IDCMP,       IDCMP_RAWKEY+IDCMP_GADGETDOWN+
  503.                          IDCMP_GADGETUP+IDCMP_MENUPICK,
  504.          WA_CUSTOMSCREEN,scr,
  505.          WA_GADGETS,     glist,0])
  506.   DrawBevelBoxA(stdrast:=win.rport,
  507.     0,inforecty:= offy:=offy-(textheight+6),scr.width,textheight+6,
  508.     [GT_VISUALINFO,visual,NIL]); INC inforecty
  509.     infox:= 5; infoy:= offy+icht.baseline+3; offy:= offy-scr.barheight-1
  510.   DrawBevelBoxA(win.rport,0,x:=scr.barheight+1,scr.width,offy,
  511.     [GT_VISUALINFO,visual,NIL])
  512.   displayinfo(welcome,0)
  513.   rectop:= x+2; recleft:=3; recwidth:= offy-5; maxlen:= scr.width-6
  514.   SetMenuStrip(win,menus); Gt_RefreshWindow(win,NIL)
  515. ENDPROC
  516.  
  517. PROC openlibs()
  518.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=0
  519.     printerrmsg('Need gadtools.library!',0); Raise(SCHLEIF)
  520.   ENDIF
  521.   IF (reqtoolsbase:=OpenLibrary('reqtools.library',38))=0
  522.     printerrmsg('No reqtools.library found!\nYou\are not able to change screenmode',0)
  523.     reqfail:= TRUE
  524.   ELSE
  525.     IF (screenmodereq:=RtAllocRequestA(RT_SCREENMODEREQ,0))=0
  526.       printerrmsg('Couldn\at allocate Screenrequesterstructure!',0)
  527.       reqfail:= TRUE
  528.     ENDIF
  529.   ENDIF
  530.   IF (keymapbase:= OpenLibrary('keymap.library',0))=0
  531.     printerrmsg('Need keymap.library!',0); Raise(SCHLEIF); ENDIF
  532. ENDPROC
  533.  
  534. PROC closelibs()
  535.   IF keymapbase    THEN CloseLibrary(keymapbase)
  536.   IF screenmodereq THEN RtFreeRequest(screenmodereq)
  537.   IF reqtoolsbase  THEN CloseLibrary(reqtoolsbase)
  538.   IF gadtoolsbase  THEN CloseLibrary(gadtoolsbase)
  539. ENDPROC
  540.  
  541. PROC closegui()
  542.   IF visual THEN FreeVisualInfo(visual)
  543.   IF win THEN CloseWindow(win)
  544.   IF scr THEN CloseScreen(scr)
  545.   IF adr; Dispose(adr); adr:=0; ENDIF
  546. ENDPROC
  547.  
  548. PROC printerrmsg(string,bodyfmt)
  549.   EasyRequestArgs(win,[20,0,0,string,' Ok ']:easystruct,0,bodyfmt)
  550. ENDPROC
  551.  
  552. CHAR '$VER: VisualSort 1.01 (3.13.94)'
  553.