DRAWING

_WindWidth@0
_WindHeight=300
_OffsetDown=30
_FontSize=12
_BlockSize=16
_FallRate=1
'-----------
LOCAL FN buildGWorld(rectPtr&)
 DIM t,l,b,r
  t;8 = rectPtr&
  QDErr = FN NEWGWORLD(theWorld&,0,#@t,0,0,0)
  LONG IF QDErr
    t$ = "Insufficient memory for GWorld"
    CALL PARAMTEXT(t$,"","","")
    controlNum%=FN NOTEALERT(128,0)
  END IF
END FN = theWorld&
'-----------
LOCAL FN disposeGWorld(theWorld&)
  LONG IF theWorld&
    CALL DISPOSEGWORLD(theWorld&)
  END IF
END FN
'-----------
LOCAL FN randomColor(rgbAdr&)
  r = RND(32767) :rgbAdr&.red% = VAL(UNS$(r<<1))
  g = RND(32767) :rgbAdr&.green% = VAL(UNS$(g<<1))
  b = RND(32767) :rgbAdr&.blue% = VAL(UNS$(b<<1))
  a& = r+g+b
  threshold& = (32767 * 3)>>1
  IF a&>threshold& THEN dark=_true ELSE dark=_false
END FN=dark
'-----------
LOCAL FN setTextRect(rectPtr&,textWidth)
  DIM textRect;8
  left=_WindWidth/2-textWidth/2
  right=left+textWidth
  CALL SETRECT(textRect, left, _OffsetDown, right, _OffsetDown+_BlockSize)
  BLOCKMOVE @textRect, rectPtr&, 8
END FN
'------------
LOCAL FN colorPorts(textWidth,a$,World&,rectPtr&)
  DIM rect;8, textRect;8, RGBback.rgbColor
  rect;8 = rectPtr&
  CALL SETPORT(World&)
  LONG COLOR 65535,0,25535
  CALL PAINTRECT(rect)
  FN setTextRect(@textRect,textWidth)
  dark=FN randomColor(@RGBback)
  CALL RGBBACKCOLOR(#@RGBback)
  IF dark THEN COLOR _zBlack ELSE COLOR _zWhite
  DEF CBOX(textRect, a$)
END FN
'-----------
LOCAL FN setRects(Rect1ptr&,Rect2ptr&,CopyRectptr&,textWidth,block)
  DIM rect;8
  right=_WindWidth/2-textWidth/2+block*_BlockSize
  left=right-_BlockSize
  CALL SETRECT(rect, left, _OffsetDown, right, _OffsetDown+_BlockSize)
  BLOCKMOVE @rect,Rect1ptr&, 8
  BLOCKMOVE @rect,Rect2ptr&, 8
  CALL SETRECT(rect, left, _OffsetDown, right, _WindHeight)
  BLOCKMOVE @rect,CopyRectptr&, 8
END FN
'----------
CLEAR LOCAL
  DIM rect;8, textRect1;8, textRect2;8, copyRect;8
  DIM block(100,2), fallLookup(50)
LOCAL FN dropMessage(a$,b$)

'figure out how wide to make bar based on longest string
  TEXT _sysFont, _FontSize
  w1 = FN STRINGWIDTH(a$) + 20
  w2 = FN STRINGWIDTH(b$) + 20
  IF w2>w1 THEN w1=w2
  blocks=w1/_BlockSize+1
  w1=blocks*_BlockSize
  LONG IF w1>_WindWidth
    Msg1$="A string is to wide"
    CALL PARAMTEXT (Msg1$,"","","")
    controlNum%=FN NOTEALERT(128,0)
  XELSE
'make window and gWorlds
    WINDOW 1, "", (0,0)-(_WindWidth, _WindHeight), _dialogFrame
    CALL SETRECT(rect, 0,0,_WindWidth, _WindHeight)

    World1&=FN buildGWorld(@rect)
    World2&=FN buildGWorld(@rect)
    World3&=FN buildGWorld(@rect)
    LONG IF World1& AND World2& AND World3&
      CALL GETGWORLD(currPort&,currDevice&)

'create a look table table of heights that accelerate
'to make the drop look real
      fallLookup(0)=0
      FOR x=1 TO 50
        i=(x*_FallRate)
        i=i+fallLookup(x-1)
        fallLookup(x)=i
      NEXT x

'Setup gGworlds
      SWAP a$, b$
      FN colorPorts(w1,a$,World1&,@rect)
      CALL SETPORT(currPort&)
      CALL COPYBITS(#World1&+2,#currPort&+2,rect.top%,rect.top%,_srcCopy,0)
      CALL COPYBITS(#World1&+2,#World2&+2,rect.top%,rect.top%,_srcCopy,0)
      CALL COPYBITS(#World1&+2,#World3&+2,rect.top%,rect.top%,_srcCopy,0)

      DO
'delay 1/2 sec.
        tick1&= FN TICKCOUNT
        DO
          tick2&= FN TICKCOUNT
        UNTIL tick2&>tick1&+30

'draw the next colored text bar
        SWAP a$, b$
        FN colorPorts(w1,a$,World1&,@rect)
        CALL SETPORT(currPort&)

'create a random order for the blocks to fall
        FOR x=0 TO blocks:block(x,2)=_false:NEXT x 'clear array
         done=0
         FOR x=0 TO blocks-1
           num=blocks-done : r = RND(num) : ex=_false
           DO
             IF block(r,2)=_true THEN INC(r) ELSE ex=_true
           UNTIL ex=_true
           block(x,1)=r : block(r,2)=_true : INC(done)
        NEXT x

'drop each block
        FOR i=0 TO blocks-1
          FN setRects(@textRect1,@textRect2,@copyRect,w1,block(i,1))
          count=0
          tick1&= FN TICKCOUNT
          DO
            CALL COPYBITS(#World1&+2,#World3&+2,copyRect.top%,copyRect.top%,_srcCopy,0)
            drop=fallLookup(count)
            CALL OFFSETRECT(textRect2,0,drop)
            CALL COPYBITS(#World2&+2,#World3&+2,textRect1.top%,textRect2.top%,_srcCopy,0)
            CALL COPYBITS(#World3&+2,#currPort&+2,copyRect.top%,copyRect.top%,_srcCopy,0)
            INC(count)
            DO 'wait a tick
              tick2&= FN TICKCOUNT
            UNTIL tick2&>tick1&+count
            IF LEN(INKEY$) THEN endrun=_true:GOTO "exitLoop"
          UNTIL drop>_WindHeight
        NEXT i
"exitLoop"
        CALL COPYBITS(#World1&+2,#World2&+2,rect.top%,rect.top%,_srcCopy,0)
      UNTIL endrun

      FN disposeGWorld(World1&)
      FN disposeGWorld(World2&)
      FN disposeGWorld(World3&)
    END IF
  END IF
END FN

d$="Press any to end this demo"
e$="Dropping text by Joe Lertola"
FN dropMessage(d$,e$)