PROGRAM MergeSortTest
?**************************************************************************
?**************************************************************************
?**   MergeSortTest   **           Neal Countryman:  completed 02/08/88  **
?**************************************************************************
?**************************************************************************
?**                                                                      **
?**    This program accepts as input N and K the respective begining and **
?** ending elements of an a array to be sorted by the Merge-Sort         **
?** algorithm.  It first sorts the array with the elements in reverse    **
?** order, printing out the number of compares.  It then preforms 100    **
?** sorts (randomly mixing up the array each time) and prints the ave.   **
?** number of compares made over the 100 trials                          **
?**                                                                      **
?** NOTE: This program is not for the squeemish as direct manipulation   **
?**       of operating system memory and data structures is used to      **
?**       effect the visual displays. F-Basic's &SYSLIB interface is     **
?**       also used for direct ROM Kernel routine calls.                 **
?**                                                                      **
?** Direct Assembly Code Is Utilized By Using F-Basic's INSERT statement **
?**                                                                      **
?** Example Input: 100 and then 200                                      **
?**                                                                      **
?**************************************************************************
?**************************************************************************

CONSTANT BLTCON0 = DFF040'16
CONSTANT BLTCON1 = DFF042'16
CONSTANT BLTAFWM = DFF044'16
CONSTANT BLTALWM = DFF046'16
CONSTANT BLTAPT  = DFF050'16
CONSTANT BLTDPT  = DFF054'16
CONSTANT BLTSIZE = DFF058'16
CONSTANT BLTAMOD = DFF064'16
CONSTANT BLTDMOD = DFF066'16


TYPE TextAttrStruct IS RECORD
   INTEGER  Name
   WORD     YSize
   BYTE     Style, Flags
ENDTYPE


SUBPROGRAM
   INTEGER    GetFont
   SUBROUTINE MergeSort, Merge, MergePrint, DrawChars, PrintArray, Mix

GLOBAL
   INTEGER  Array1, Array2, Size, FontPTR, BP1, SCR, WND, GraBase
   REAL     Count

LOCAL
   INTEGER  N, K, X, Y, A1(5000), A2(5000)



GraBase = OPENLIB("graphics.library",0)
IF GraBase = 0 THEN
   PRINT "ERROR -- Unable to open the graphics library."
   STOP
ENDIF

IF GetFont() = 0 THEN
   PRINT "ERROR -- Unable to access internal TOPAZ8 font."
   STOP
ENDIF

SCR = SCREEN #1 (0,200,2,2,0)
IF SCR = 0 THEN
   PRINT "ERROR -- Unable to open 640x200 screen."
   FontPTR = DEALLOCATE(2048,FontPTR)
   STOP
ENDIF
BP1 = #(SCR + 192)

WND = WINDOW #1 (0,0,640,200,0,0,0,0,-1,-1,0,0,1)
IF WND = 0 THEN
   PRINT "ERROR -- Unable to open window on custom screen."
   SCREEN_CLOSE #1
   FontPTR = DEALLOCATE(2048,FontPTR)
   STOP
ENDIF
CURS_INVS

FOR X = BP1 TO BP1+80 STEP 4
   #X = 0
NEXT X
FOR X = BP1+158 TO BP1+15918 STEP 80
   #X = 0
NEXT X
FOR X = BP1+15920 TO BP1+15996 STEP 4
   #X = 0
NEXT X



MergePrint(10,@"                        WELCOME TO MERGE-SORT TESTER")


DELAY(20)
Array1 = @A1
Array2 = @A2

{GetN}
MergePrint(42,@"Please enter a starting array element N:")
CURS_LOC(7,43)
CURS_VIS
INPUT N
CURS_INVS
IF N<0 OR N>9999 THEN
   CURS_LOC(9,1)
   PRINT"N must be in the range:  -1<N<10000 ... please re-enter."
   DELAY(30)
   CURS_LOC(7,1)
   ERA_ALL
   GOTO GetN
ENDIF

{GetK}
MergePrint(66,@"Please enter an ending array element K:")
CURS_LOC(10,42)
CURS_VIS
INPUT K
CURS_INVS
IF K<0 OR K>9999 THEN
   CURS_LOC(12,1)
   PRINT"K must be in the range:  -1<N<10000 ... please re-enter."
   DELAY(30)
   CURS_LOC(10,1)
   ERA_ALL
   GOTO GetK

ELSE IF K<N THEN
   CURS_LOC(12,1)
   PRINT"K must be greater than or equal to N ... please re-enter."
   DELAY(30)
   CURS_LOC(10,1)
   ERA_ALL
   GOTO GetK

ELSE IF K-N > 4999 THEN
   CURS_LOC(12,1)
   PRINT"K and N can not span more than 5000 elements ... please re-enter."
   DELAY(30)
   CURS_LOC(10,1)
   ERA_ALL
   GOTO GetK
ENDIF

Y = K
FOR X = Array1 TO Array1+((K-N) ASL 2) STEP 4
   #X = Y
   DEC(Y)
NEXT X

Size = K = (K-N) ASL 2
N = 0


Count = 0
PrintArray()
CURS_LOC(12,1)
PRINT "SORTING ARRAY"
MergeSort(N, K)
CURS_LOC(12,1)
PRINT "`Reverse Filled Case' number of compares: ",Count[F10.2]
PrintArray()

PRINT "Press <RETURN> to continue ",
INPUT X

CURS_LOC(13,1)
PRINT "SORTING ARRAY                "
FOR X = 1 TO 100
   Mix()
   MergeSort(N,K)
NEXT X
CURS_LOC(13,1)
PRINT "Average number of compares over 100 sorts: ",Count/100[F10.2]
PrintArray()



DELAY(100)

WINDOW_CLOSE #1
SCREEN_CLOSE #1
FontPTR = DEALLOCATE(2048,FontPTR)

END



SUBROUTINE MergeSort
?************************************************************************
?**  MergeSort  **                                         NC: 01/31/88 *
?************************************************************************
?*                                                                      *
?*    This is the recursive sorting algorithm in question this week.    *
?* Let's see how she works.                                             *
?*                                                                      *
?************************************************************************

   PARAMETER
      INTEGER  N, K

   LOCAL
      INTEGER  Middle


{BODY}
   IF K=N THEN GRETURN

   Middle = N + (((K-N) ASR 1) AND FFFFFFFC'16)
   MergeSort(N, Middle)
   MergeSort((Middle + 4), K)

   Merge(N, K, Middle)
   GRETURN
END


SUBROUTINE Merge
?************************************************************************
?**  Merge  **                                             NC: 01/31/88 *
?************************************************************************
?*                                                                      *
?*    This routine merges the STUFF from Array1 into Array2 and then    *
?* copies it back into Array1.                                          *
?*                                                                      *
?************************************************************************

   PARAMETER
      INTEGER  N, K, Middle

   LOCAL
      INTEGER  Top, Bot, End, Ptr, Ptr2


   End = K + Array1
   Ptr = Ptr2 = N + Array2
   Top = N = N + Array1
   Bot = Middle + Array1 + 4
   Middle = Middle + Array1

   WHILE (Top <= Middle) AND (Bot <= End)
      Count = Count + 1
      IF #Top < #Bot THEN
         #Ptr+ = #Top
         INC(Top,4)
      ELSE
         #Ptr+ = #Bot
         INC(Bot,4)
      ENDIF
   ENDWHILE

   WHILE (Top <= Middle)
      #Ptr+ = #Top
      INC(Top,4)
   ENDWHILE

   WHILE (Bot <= End)
      #Ptr+ = #Bot
      INC(Bot,4)
   ENDWHILE

   WHILE (N <= End)
      #N+ = #Ptr2
      INC(Ptr2,4)
   ENDWHILE

   GRETURN
END



SUBROUTINE MergePrint
?************************************************************************
?**  MergePrint  **                                        NC: 01/30/88 *
?************************************************************************
?*                                                                      *
?*    This routine does funky string printing to enhance the idea of a  *
?* merge sort.                                                          *
?*                                                                      *
?************************************************************************

   PARAMETER
      INTEGER  YPos, StringPTR

   LOCAL
      INTEGER  Shift, Index, Top, Bot, Chr, PTR, Flag, Delay


{BODY}
   YPos = BP1 + (YPos ASL 6) + (YPos ASL 4) + 1
   FOR Shift = 0 TO 7

      Top = YPos + 560
      Bot = YPos + 1280
      FOR PTR = 0 TO 6
         FOR Index = 1 TO 40
            ^Top+ = ^(Top - 80)
            ^Bot+ = ^(Bot + 80)
         NEXT Index
         DEC(Top,120)
         INC(Bot,40)
      NEXT PTR

      Top = YPos
      Bot = YPos + 1840
      Flag = 0
      PTR = StringPTR
      Chr = 0

      WHILE ^PTR
         Chr = ^PTR ASL 3
         INC(PTR)

         IF Flag THEN
            ^Top = ^(FontPTR + Chr + (7 - Shift))
            INC(Top)
         ELSE
            ^Bot = ^(FontPTR + Chr + Shift)
            INC(Bot)
         ENDIF

         Flag = NOT Flag
      ENDWHILE

      FOR Delay = 1 TO 10000
      NEXT Delay
   NEXT Shift


?** Use the blitter to shift the characters. **
   &SYSLIB 1
      OwnBlitter(GraBase)
      WaitBlit(GraBase)

      $(BLTCON0) = 0001100111110000'2
      $(BLTCON1) = 0000000000000000'2
      $(BLTALWM) = FFFF'16
      $(BLTAFWM) = FFFF'16
      FOR PTR = 76 TO 6 STEP -2
         FOR Index = 1 TO 8
            $(BLTAMOD) = 80 - PTR
            $(BLTDMOD) = 80 - PTR
            #(BLTAPT)  = YPos + (77 - PTR)
            #(BLTDPT)  = YPos + (77 - PTR)
            $(BLTSIZE) = 1536 + (PTR ASR 1)
            WaitBlit(GraBase)

            FOR Delay = 1 TO 1000
            NEXT Delay
         NEXT Index
      NEXT PTR

      $(BLTAMOD) = 2
      $(BLTDMOD) = 2
      FOR Index = 1 TO 8
         #(BLTAPT)  = YPos - 1
         #(BLTDPT)  = YPos - 1
         $(BLTSIZE) = 512 + 39
         WaitBlit(GraBase)
         FOR Delay = 1 TO 5000
         NEXT Delay
      NEXT Index

      DisownBlitter(GraBase)
   &SYSLIB 0

   FOR Shift = 15 TO 1 STEP -2
      Top = YPos + 1201
      Bot = YPos + 560
      FOR PTR = 0 TO Shift
         FOR Index = 1 TO 40
            ^Top = ^(Top - 80)
            ^Bot = ^(Bot + 80)
            INC(Top,2)
            INC(Bot,2)
         NEXT Index
         DEC(Top,160)
      NEXT PTR
      FOR Delay = 1 TO 7000
      NEXT Delay
   NEXT Shift

   FOR Shift = 80 TO 640 STEP 80
      Top = YPos + 1201 - Shift
      Bot = YPos + 640 + Shift
      FOR PTR = 0 TO 14
         FOR Index = 1 TO 40
            ^Top = ^(Top - 80)
            ^Bot = ^(Bot + 80)
            INC(Top,2)
            INC(Bot,2)
         NEXT Index
         DEC(Top,160)
      NEXT PTR
      FOR Delay = 1 TO 7000
      NEXT Delay
   NEXT Shift

   GRETURN
END




FUNCTION GetFont
?************************************************************************
?**  GetFont  **                                            NC: 11/6/87 *
?************************************************************************
?*    This function finds the system font data for the Topaz8 and copies*
?* it into an array for personal use.  The array that the data gets     *
?* stored in must be pointed to by the global pointer FontPTR.          *
?*    If there is a problem in finding the font, the value returned by  *
?* this routine is 0, if everything went OK, it returns a 1.            *
?************************************************************************

   LOCAL
      INTEGER        Char, Offset, CharLines, PresLoc, TextFont, CharLoc
      INTEGER        CharData, GBase
      TextAttrStruct TAS


{BODY}
   TAS.Name  = @"topaz.font"
   TAS.YSize = 8
   TAS.Style = 0
   TAS.Flags = 0

   FontPTR = ALLOCATE(2048)
   IF FontPTR = 0 THEN
      GetFont = 0
      GRETURN
   ENDIF

   &SYSLIB 1
   TextFont = OpenFont(GraBase,@TAS)
   &SYSLIB 0
   IF TextFont = 0 THEN
      GetFont = 0
      GRETURN
   ENDIF

   CharLoc  = #(TextFont + 40)
   CharData = #(TextFont + 34)

   PresLoc = FontPTR + 256
   FOR Char = 0 TO 892 STEP 4
      Offset = ($(CharLoc + Char) LSR 3) + CharData
      FOR CharLines = 0 TO 1344 STEP 192
         ^PresLoc+ = ^(Offset + CharLines)
      NEXT CharLines
   NEXT Char
   GetFont = 1

   GRETURN
END



SUBROUTINE DrawChars
?************************************************************************
?**  DrawChars  **                                         NC: 11/09/87 *
?************************************************************************
?*                                                                      *
?*    This assembly subroutine draws font data directly into screen     *
?* memory.  It takes font data from a global data array generated by    *
?* GetFontData.  It assumes that you passed it a pointer to the string  *
?* that you want printed, and the address of where you want it to start *
?* printing it {i.e.  DrawChars(@"Hi there",BitPlane+2000)}.            *
?*    The address you send will be the possition of the top line of the *
?* left most character.                                                 *
?*    Strings are 0 ending so you need not worry about the string       *
?* length, UNLESS IT GOES BEYOND THE RIGHT EDGE OF THE SCREEN!          *
?*                                                                      *
?*    WARNING: This routine does not check the address you send.  If    *
?* you ask it to print merrily through memory....it will.               *
?******************************************************************************************************
?*                                                                                                    *
?*   48E7  F038           DrawChars:     MOVEM.L  D0-D3/A2-A4,-(A7)                                   *
?*   2468  0008                          MOVE.L   8(A0),A2          ;Get a pointer to the string.     *
?*   2668  000C                          MOVE.L   12(A0),A3         ;Get Screen location.             *
?*   223C  0000  0050                    MOVE.L   #80,D1                                              *
?*   243C  0000  027F                    MOVE.L   #639,D2                                             *
?*                                                                                                    *
?*   2849                 MoreToCome:    MOVE.L   A1,A4             ;Don't trash the font pointer     *
?*   7000                                MOVEQ    #0,D0                                               *
?*   101A                                MOVE.B   (A2)+,D0          ;Get character from string.       *
?*   6712                                BEQ.S    DrawsDone                                           *
?*   E748                                LSL      #3,D0             ;Multiply it by 8 to get offset.  *
?*   D9C0                                ADD.L    D0,A4             ;Add offset to data pointer.      *
?*   7607                                MOVEQ    #7,D3                                               *
?*                                                                                                    *
?*   169C                 PukeItFast:    MOVE.B   (A4)+,(A3)        ;Move data to screen.             *
?*   D7C1                                ADD.L    D1,A3             ;Move down a line.                *
?*   51CB  FFFA                          DBF      D3,PukeItFast     ;Do that 8 times.                 *
?*                                                                                                    *
?*   97C2                                SUB.L    D2,A3             ;Move to next char. position.     *
?*   60E6                                BRA.S    MoreToCome                                          *
?*                                                                                                    *
?*   4CDF  1C0F           DrawsDone:     MOVEM.L  (A7)+,D0-D3/A2-A4                                   *
?*                                                                                                    *
?*                                       END                                                          *
?******************************************************************************************************

   PARAMETER
      INTEGER StringPTR, DrawLoc


{BODY}
   :A1 = FontPTR
   INSERT "48E7F038"
   INSERT "24680008"
   INSERT "2668000C"
   INSERT "223C00000050"
   INSERT "243C0000027F"
   INSERT "2849"
   INSERT "7000"
   INSERT "101A"
   INSERT "6712"
   INSERT "E748"
   INSERT "D9C0"
   INSERT "7607"
   INSERT "169C"
   INSERT "D7C1"
   INSERT "51CBFFFA"
   INSERT "97C2"
   INSERT "60E6"
   INSERT "4CDF1C0F"
   GRETURN
END



SUBROUTINE PrintArray
?************************************************************************
?**  PrintArray  **                                        NC: 02/07/88 *
?************************************************************************
?*                                                                      *
?*    This routine prints out some of the elements of the array to show *
?* that it was infact sorted.                                           *
?*                                                                      *
?************************************************************************

   LOCAL
      INTEGER  X, Y, Num, Start, Z, End
      TEXT     NumStr*9


   NumStr = "        " & CHAR(0)
   Start = Array1
   Y = 10
   X = BP1 + 9600
   End = Size + Array1
   WHILE (Start <= End) AND (X < BP1 + 16000)
      Num = #Start
      INC(Start,4)
      FOR Z = 6 TO 3 STEP -1
         NumStr(Z) = CHAR(Num\10 + 48)
         Num = Num/10
      NEXT Z
      DrawChars(@NumStr, X)
      INC(X,8)
      DEC(Y)
      IF Y=0 THEN
         Y = 10
         INC(X,560)
      ENDIF
   ENDWHILE

   GRETURN
END



SUBROUTINE Mix
?************************************************************************
?**  Mix  **                                               NC: 02/07/88 *
?************************************************************************
?*                                                                      *
?*    This routine randomly mixes up the array through element "Size".  *
?*                                                                      *
?************************************************************************

   LOCAL
      INTEGER  Ptr1, Ptr2, Temp


   Ptr1 = Array1
   WHILE Ptr1 <= Size+Array1
      Ptr2 = ((RANDOM()\(Size+4)) AND FFFC'16) + Array1
      Temp = #Ptr1
      #Ptr1+ = #Ptr2
      #Ptr2 = Temp
   ENDWHILE

   PrintArray()

   GRETURN
END