TEXT

'=========================================
LOCAL FN disposeBWorld(BWworld&)
'---------------------------------------
' Dispose of a black and white offscreen
' grafPort.
'---------------------------------------
  DIM oldPort&,frontWnd&
  DIM bitMapPtr&,OSErr

  LONG IF BWworld&
    CALL GETPORT(oldPort&)
    LONG IF oldPort& = BWworld&
      frontWnd& = FN FRONTWINDOW
      CALL SETPORT(frontWnd&)
    END IF
    bitMapPtr& = [BWworld& + _portBits]
    CALL CLOSEPORT(BWworld&)
    OSErr = FN DISPOSPTR(BWworld&)
    OSErr = FN DISPOSPTR(bitMapPtr&)
  END IF
END FN

LOCAL FN buildBWorld(@rectPtr&)
'---------------------------------------
' Create a black and white offscreen
' grafPort.
'---------------------------------------
  DIM bitMapPtr&,rowBytes,t,l,b,r,t$
  DIM BWworld&,mapSize&
  DIM oldPort&,clipRgnRect&,visrgnRect&
  DIM OSErr

  bitMapPtr& = 0
  t;8 = rectPtr&
  CALL GETPORT(oldPort&)
  BWworld& = FN NEWPTR _clear(_grafSize)
  LONG IF BWworld&
    CALL OPENPORT(BWworld&)
    rowBytes = (((r - l) + 15)/8) AND &7FFE
    mapSize& = rowBytes * ((b - t) + 1)
    BLOCKMOVE @t,BWworld&+_portRect,8
    bitMapPtr& = FN NEWPTR _clear(mapSize&)
    LONG IF bitMapPtr&
      BLOCKMOVE @bitMapPtr&,BWworld&+_portBits,14
      CALL PENNORMAL
      CALL OFFSETRECT(t,-l,-t)
      clipRgnRect& = [[BWworld& + _clipRgn]] + 2
      BLOCKMOVE @t,clipRgnRect&,8
      visrgnRect& = [[BWworld& + _visRgn]] + 2
      BLOCKMOVE @t,visrgnRect&,8
      CALL ERASERECT(gBigT)
    XELSE
      OSErr = FN DISPOSPTR(BWworld&)
      BWworld& = 0
      t$ = "Insufficient memory for BWorld"
      CALL PARAMTEXT(t$,"GRFX 1","","")
      BEEP
    END IF
  END IF
  CALL SETPORT(oldPort&)
END FN = BWworld&

'=========================================
LOCAL FN TEXTstretch(@rectPrt&,theText$)
'---------------------------------------
' Stretch text to fit rectangle.
'---------------------------------------
  DIM num&;0,Vnumerator,Hnumerator
  DIM denom&;0,Vdenominator,Hdenominator
  DIM srcRectT,srcRectL,srcRectB,srcRectR
  DIM destRectT,destRectL,destRectB,destRectR
  DIM ascent,descent,fWidth,leading
  DIM thePort&,oldSz,txtPtr&,theCount
  DIM proptn1Desc,proptnHAdd,stdTxtProc&

  CALL SETRECT(srcRectT,0,0,0,0)
  destRectT;8 = rectPrt&
  CALL INSETRECT(destRectT,1,1)
  CALL GETPORT(thePort&)
  oldSz = {thePort& + _txSize}
  CALL TEXTSIZE(100)

  LONG IF LEN(theText$)
    txtPtr& = @theText$ + 1
    theCount = LEN(theText$)
    CALL GETFONTINFO(ascent)
    srcRectB = srcRectT + USR FONTHEIGHT - leading
    srcRectR = srcRectL + FN STRINGWIDTH(theText$) + fWidth

: Vnumerator = (destRectB - destRectT)
'------------ -----------------------
:Vdenominator = (srcRectB - srcRectT)


: Hnumerator = (destRectR - destRectL)
'------------ -----------------------
:Hdenominator = (srcRectR - srcRectL)

    proptn1Desc = (descent * Vnumerator)/Vdenominator
    proptnHAdd = ((fWidth >> 1) * (100 * Hnumerator/Hdenominator))/100
    CALL MOVETO(destRectL + proptnHAdd,destRectB - proptn1Desc)
    CALL TEXTMODE(_srcOr)
    LONG IF [thePort& + _grafProcs]
      stdTxtProc& = [[thePort& + _grafProcs]]
      CALL stdTxtProc&(theCount,txtPtr&,num&,denom&)
    XELSE
      CALL STDTEXT(theCount,txtPtr&,Vnumerator,Vdenominator)
    END IF
  END IF
  CALL TEXTSIZE(oldSz)
END FN

'=========================================
LOCAL FN TEXTrotate(clockwise,@rectPtr&,theText$)
'---------------------------------------
  DIM t,l,b,r
  DIM theStart&;0,startPointY,startPointX
  DIM theEnd&;0 ,endPointY ,endPointX
  DIM theDest&;0 ,destY ,destX
  DIM portInfo;8
  DIM outputWnd,targetPort&
  DIM top,left,wd,ht,BWorld&,col,row
  DIM plotting

  outputWnd = WINDOW(_outputWnd)
  CALL GETPORT(targetPort&)
  portInfo;8 = targetPort& + _txFont
  t;8 = rectPtr&
  top = t
  left = l
  wd = r - l
  ht = b - t
  CALL SETRECT(t,0,0,ht,wd)
  BWorld& = FN buildBWorld(t)

  LONG IF BWorld& = 0
    CALL SETPORT(targetPort&)
    IF outputWnd THEN WINDOW OUTPUT outputWnd
    EXIT FN
  END IF

  CALL SETPORT(BWorld&)
  BLOCKMOVE @portInfo,BWorld& + _txFont,8
  FN TEXTstretch(t,theText$)
  CALL SETPORT(targetPort&)
  IF outputWnd THEN WINDOW OUTPUT outputWnd
  PEN 1,1
  CALL INSETRECT(t,1,1)

  LONG IF clockwise
    destY = top
  XELSE
    destY = top + r
  END IF

  FOR col = l TO r
    LONG IF clockwise
      INC(destY)
      destX = left+b
    XELSE
      DEC(destY)
      destX = left
    END IF
    plotting = _false

    FOR row = t TO b
      IF clockwise THEN DEC(destX) ELSE INC(destX)
      ` MOVEA.L ^BWorld&,A1
      ` MOVEQ #0,D0
      ` MOVEQ #0,D1
      ` MOVE.W ^row,D0
      ` SUB.W $0008(A1),D0
      ` MOVE.W ^col,D1
      ` SUB.W $000A(A1),D1
      ` MULU.W $0006(A1),D0
      ` MOVEA.L $0002(A1),A1
      ` ADDA.L D0,A1
      ` MOVE.W D1,D0
      ` NOT.W D0
      ` LSR.W #$3,D1
      ` BTST D0,$00(A1,D1.W)
      ` SNE D0
      ` NEG.B D0
      ` EXT.W D0
      ` EXT.L D0
      LONG IF REGISTER(D0)
        LONG IF plotting
          theEnd& = theDest&
        XELSE
          plotting = _zTrue
          theStart& = theDest&
          theEnd& = theDest&
        END IF
      XELSE
        LONG IF plotting
          plotting = _false
          CALL MOVETO(startPointX,startPointY)
          CALL LINETO(endPointX,endPointY)
        END IF
      END IF
    NEXT row
  NEXT col
  FN disposeBWorld(BWorld&)
  CALL PENNORMAL
END FN

WINDOW 1
DIM rectangle;8
TEXT _times, 24

textString$ = "This is a test!"
rightCorner% = 50
topCorner% = 50
roateClockwise% = _true

CALL SETRECT(rectangle,rightCorner%,topCorner%,rightCorner%+USR FONTHEIGHT,topCorner%+FN STRINGWIDTH(textString$))

FN TEXTrotate(roateClockwise%,rectangle,textString$)

DO
UNTIL FN BUTTON
SYSTEM