FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

DRAWING

Rotate GWorlds


Here's one way to do it. You'll have to do your own adaptations of the code and figure out (without REMs) how everything works.

LOCAL
  DIM SrcGW&,DstGW&,how,err
  DIM SPixMap&,SColors,SRowBytes,SPixels&
  DIM SrcT,SrcL,SrcB,SrcR
  DIM SrcRowPtr&
'
  DIM DPixMap&,DColors,DRowBytes,DPixels&
  DIM DstT,DstL,DstB,DstR
'
  DIM dxx,dxy,dyy,dyx
  DIM dstY,dstX,Y,X
'
LOCAL FN ImageRotate(SrcGW&,DstGW&,how)
'
  err = _zTrue
'
  LONG IF SrcGW& <> 0 AND DstGW& <> 0
'
    LONG IF SrcGW&.portbits.rowbytes% < 0
      SPixMap& = [[SrcGW&+2]]
      SColors = {SPixMap&+_pmPixelSize}
      SRowBytes = {SPixMap&+_RowBytes} AND &3FFF
      SPixels& = [SPixMap&]
      SrcT;8 = SPixMap&+_Bounds
    XELSE
      SPixels& = SrcGW&.portbits.BaseAddr&
      SRowBytes = SrcGW&.portbits.rowbytes%
      SrcT;8 =@SrcGW&.portbits.bounds%
      SColors = 1
    END IF
'
    LONG IF DstGW&.portbits.rowbytes% < 0
      DPixMap& = [[DstGW&+2]]
      DColors = {DPixMap&+_pmPixelSize}
      DRowBytes = {DPixMap&+_RowBytes} AND &3FFF
      DPixels& = [DPixMap&]
      DstT;8 = DPixMap&+_Bounds
    XELSE
      DPixels& = DstGW&.portbits.BaseAddr&
      DRowBytes = DstGW&.portbits.rowbytes%
      DstT;8 =@DstGW&.portbits.bounds%
      DColors = 1
    END IF
'
    CURSOR -_WatchCursor
    err = _False
'
    SELECT CASE how
      CASE _RotateLeft : dxx = 0 : dxy = 1 : dyy = 0 : dyx =-1
      CASE _RotateRight : dxx = 0 : dxy =-1 : dyy = 0 : dyx = 1
      CASE _FlipHorz : dxx =-1 : dxy = 0 : dyy = 1 : dyx = 0
      CASE _FlipVert : dxx = 1 : dxy = 0 : dyy =-1 : dyx = 0
      CASE _Rotate180 : dxx =-1 : dxy = 0 : dyy =-1 : dyx = 0
    END SELECT
'
    IF dyy < 0 THEN dstY = DstB-1 ELSE dstY = 0
    IF dxy < 0 THEN dstX = DstR-1 ELSE dstX = 0
    SrcRowPtr& = SPixels&
    FOR Y = 0 TO SrcB-1
      IF dyx THEN IF dyx < 0 THEN dstY = DstB-1 ELSE dstY = 0
      IF dxx THEN IF dxx < 0 THEN dstX = DstR-1 ELSE dstX = 0
      FOR X = 0 TO SrcR-1
        ` MOVE.L ^SrcRowPtr&,A2
        ` MOVE.L ^DPixels&,A1
        ` MOVE.W ^dstY,D0
        ` MULS.W ^DRowBytes,D0
        ` ADD.L D0,A1 ;ADDR OF DST BYTE WITH PIXEL
        SELECT CASE SColors
          CASE 1
'======== BEGIN B&W PIXEL ROUTINES ==========
'
            ` MOVEQ #0,D1
            ` MOVE.W ^X,D1 ;*** 1 bit ***
            ` MOVE.W D1,D3 ;PIXEL # TO D2
            ` LSR.L #3,D1 ;BYTE #
            ` ADD.L D1,A2 ;ADDR OF SRC BYTE WITH PIXEL
            ` NOT.B D3 ;SRC BIT #
'
            ` MOVEQ #0,D1
            ` MOVE.W ^dstX,D1 ;*** 1 bit ***
            ` MOVE.W D1,D2 ;PIXEL # TO D2
            ` LSR.L #3,D1 ;BYTE #
            ` ADD.L D1,A1
            ` NOT.B D2 ;DST BIT #
'
            ` BTST D3,(A2)
            ` BNE.S SETPIX
            ` BCLR D2,(A1) ;CLR THE PIXEL
            ` BRA.S PIXEND
'
            `SETPIX BSET D2,(A1) ;SET THE PIXEL
            `PIXEND NOP
'----------------- END B&W PIXEL ROUTINES ------------------
          CASE 8
            ` ADD.W ^X,A2
            ` ADD.W ^dstX,A1
            ` MOVE.B (A2),(A1)
'''POKE DPixels& + dstY*DRowBytes + dstX,PEEK(SrcRowPtr& + X)
          CASE 16
            ` ADD.W ^X,A2
            ` ADD.W ^X,A2
            ` ADD.W ^dstX,A1
            ` ADD.W ^dstX,A1
            ` MOVE.W (A2),(A1)
'''% DPixels& + dstY*DRowBytes + dstX+dstX , {SrcRowPtr& + X+X}
          CASE 32
            ` MOVE.W ^X,D0
            ` LSL.W #2,D0
            ` ADD.W D0,A2
            ` MOVE.W ^dstX,D0
            ` LSL.W #2,D0
            ` ADD.W D0,A1
            ` MOVE.L (A2),(A1)
'''& DPixels& + dstY*DRowBytes + dstX*4 , [SrcRowPtr& + X*4]
        END SELECT
        dstY = dstY + dyx : dstX = dstX + dxx
      NEXT
      dstY = dstY + dyy : dstX = dstX + dxy
      SrcRowPtr& = SrcRowPtr& + SRowBytes
    NEXT
'
  END IF
'
END FN = err

STAZ ~)~


In order for Staz's image rotate FN (which he so kindly posted) to work correctly, the source and output gWorlds must be locked before calling the FN and then can be unlocked after calling the FN. Thanks to Andy Gariepy for figuring this out so promptly....

In PG: PRO the FN's are:

FN RdWrLockWorld(World&)
FN RdWrUnlockWorld(World&)

For you straight FB users, contact Staz....

Michael Evans


It's been a quiet week on the list, with few juicy code examples. In view of the recent discussion of picture rotation I thought I would post a 90-degree rotation method with two advantages:
(1) It works in _any_ color depth.
(2) It will use up many spare leisure hours while you try to understand it.

' Adapted from C to FutureBasic by Robert Purves, February, 1999
' and enhanced for colour pictures, by courtesy of GWorlds

' Originally written by:
' Robert B. Denny, Alisa Systems, Inc. September, 1985
' Copyright (C) 1985, MacTutor Magazine
' Permission granted to use only for non-commercial purposes.
' This notice must be included in any copies made hereof.
' All rights otherwise reserved.

LOCAL FN WeirdRotate(scrnDev&,sGW&,mGW&,tGW&,rectPtr&,dlayPrm)
  DIM fullWidth, halfWidth,err,nowHalf, xRect.8, yRect.8, rect.8
  BLOCKMOVE rectPtr&,@rect,8
  fullWidth=rect.right
  halfWidth=fullWidth>>1
  err=FN LOCKPIXELS(FN GETGWORLDPIXMAP(mGW&))
  err=FN LOCKPIXELS(FN GETGWORLDPIXMAP(tGW&))
' Paint starting mask into mask GWorld
  CALL SETGWORLD(mGW&,0)
  CALL ERASERECT(rect)
  CALL SETRECT (xRect,0,0,halfWidth,halfWidth)' Upper left quadrant
  COLOR=_zBlack
  CALL PAINTRECT (xRect)
  CALL SETGWORLD(sGW&,scrnDev&)
  nowHalf=halfWidth
  WHILE (nowHalf) ' Main loop
    xRect=rect
    yRect=rect
'Phase 1 - swap left and right cell halves
    CALL COPYBITS (#mGW&+2, #tGW&+2, xRect, xRect, _srcCopy, 0)
    CALL OFFSETRECT (yRect, 0, nowHalf)
    CALL COPYBITS (#mGW&+2, #tGW&+2, xRect, yRect, _srcOr, 0)
    CALL COPYBITS (#sGW&+2, #tGW&+2, rect, xRect, _notSrcBic, 0)
    CALL COPYBITS (#tGW&+2, #sGW&+2, xRect, rect, _srcXor, 0)
    CALL OFFSETRECT (yRect, -nowHalf, -nowHalf)
    CALL COPYBITS (#sGW&+2, #tGW&+2, rect, yRect, _srcXor, 0)
    CALL COPYBITS (#sGW&+2, #sGW&+2, rect, yRect, _srcOr, 0)
    CALL OFFSETRECT (yRect, nowHalf << 1, 0)
    CALL COPYBITS (#tGW&+2, #sGW&+2, xRect, yRect, _srcXor, 0)
'Phase 2 - Exchange lower-right and upper-left cell quadrants
    CALL COPYBITS (#sGW&+2, #tGW&+2, rect, xRect, _srcCopy, 0)
    CALL OFFSETRECT (yRect, -(nowHalf << 1), -nowHalf)
    CALL COPYBITS (#sGW&+2, #tGW&+2, rect, yRect, _srcXor, 0)
    CALL COPYBITS (#mGW&+2, #tGW&+2, xRect, xRect, _notSrcBic, 0)
    CALL COPYBITS (#tGW&+2, #sGW&+2, xRect, rect, _srcXor, 0)
    CALL OFFSETRECT (yRect, nowHalf << 1, nowHalf<< 1)
    CALL COPYBITS (#tGW&+2, #sGW&+2, xRect, yRect, _srcXor, 0)
'Phase 3 - Refine mask for next smaller cell size
    CALL SETRECT (xRect, 0, 0, halfWidth, halfWidth)
    CALL SETRECT (yRect, 0, halfWidth, halfWidth, fullWidth)
    CALL COPYBITS (#mGW&+2, #mGW&+2, rect, xRect, _srcCopy, 0)
    CALL COPYBITS (#mGW&+2, #mGW&+2, xRect, yRect, _srcCopy, 0)
    CALL SETRECT (xRect, 0, 0, halfWidth, fullWidth)
    CALL SETRECT (yRect, halfWidth, 0, fullWidth, fullWidth)
    CALL COPYBITS (#mGW&+2, #mGW&+2, xRect, yRect, _srcCopy, 0)
    nowHalf=nowHalf>>1 ' Reduce cell size by 1/2
    DELAY (dlayPrm) ' allow viewing
  WEND
  CALL UNLOCKPIXELS(FN GETGWORLDPIXMAP(mGW&))
  CALL UNLOCKPIXELS(FN GETGWORLDPIXMAP(tGW&))
END FN

LOCAL FN DrawStuff(sqSize)
  DIM j, rect.8, s$
  CALL SETRECT(rect,0,0,sqSize/2,sqSize/2)
  COLOR=_zCyan: CALL PAINTRECT(rect)
  CALL OFFSETRECT(rect,sqSize/2,0)
  COLOR=_zYellow: CALL PAINTRECT(rect)
  CALL OFFSETRECT(rect,0,sqSize/2)
  COLOR=_zGreen: CALL PAINTRECT(rect)
  CALL OFFSETRECT(rect,-sqSize/2,0)
  COLOR=_zBlue: CALL PAINTRECT(rect)
  CALL SETRECT(rect,sqSize/16, sqSize*7/16,sqSize*15/16, sqSize*9/16)
  CALL ERASEOVAL(rect)
  CALL PENSIZE(1,3)
  FOR j=1 TO sqSize/8
    LONG COLOR 255*RND(256),0,255*RND(256)
    IF (j AND 3) =3 THEN COLOR=_zWhite
    CALL FRAMEOVAL(rect)
    CALL INSETRECT(rect,-1,-3)
  NEXT
  COLOR=_zBlack
  CALL TEXTSIZE(sqSize/10)
  s$="Weird Rotation"
  PRINT%(sqSize/2-FN STRINGWIDTH(s$)/2,sqSize*17/32) s$
END FN

DIM scrnGW&,scrnDev&, maskGW&, tempGW&,theWidth, theRect.8
IF SYSTEM(_scrnHeight)>520 THEN theWidth=512 ELSE theWidth=256'power of 2
CALL SETRECT(theRect,0,0,theWidth,theWidth)
WINDOW 1,"Strange",@theRect,5
CALL GETGWORLD(scrnGW&,scrnDev&)
IF FN NEWGWORLD(maskGW&,0,#@theRect,0,0,0)<>_noErr THEN STOP
IF FN NEWGWORLD(tempGW&,0,#@theRect,0,0,0)<>_noErr THEN STOP
FN DrawStuff(theWidth) ' put up some pretty rubbish to rotate
DO: UNTIL FN BUTTON
FN WeirdRotate(scrnDev&,scrnGW&,maskGW&,tempGW&, @theRect,1200)
DO: UNTIL FN BUTTON
CALL DISPOSEGWORLD(maskGW&)
CALL DISPOSEGWORLD(tempGW&)

How does it work? The series of masked and shifted COPYBITS calls in FN WeirdRotate rotates the 4 quadrants of the picture. Each iteration then refines the mask to subdivide each quadrant into 4, until finally the 4x4 pixel sub-sub-sub.. quadrants are the last to be rotated, all at once (you can see this as "de-fuzzing" on the last iteration). I think of it as a 2-dimensional generalisation of the old trick to exchange two variables:-

y=y XOR x
x=x XOR y
y=y XOR x

Robert