REM. Apple deform 3
     REM. Version 1.2 // 16-Mar-2012
     REM. A rotating, stretching, squashing, colour-changing apple


     *ESC OFF


     *FLOAT 64


     ON ERROR PROCerror( REPORT$, TRUE )


     REM. Reserve 2 MB of RAM for this program
     M% = 2
     HIMEM = LOMEM + M%*&100000
     HIMEM = (HIMEM + 31) AND -32


     REM. Prevent the user from resizing the window
     REM. (although it can still be minimized)
     PROCfixWindowSize


     SYS "SetWindowText", @hwnd%, "A rotating, stretching, squashing, colour-changing apple"


     REM. Set our program window's dimensions
     WinW% = 640
     WinH% = 512
     VDU 23, 22, WinW%; WinH%; 8, 16, 16, 0 : OFF


     REM. Install and initialise GFXLIB and the required external modules
     INSTALL @lib$ + "GFXLIB2"                              : PROCInitGFXLIB
     INSTALL @lib$ + "GFXLIB_modules\BPlotScaleNC.BBC"      : PROCInitModule
     INSTALL @lib$ + "GFXLIB_modules\PlotRotateScale2.BBC"  : PROCInitModule
     INSTALL @lib$ + "GFXLIB_modules\ChangeBitmapRGBLevels" : PROCInitModule


     REM. Load in the 400x400 apple bitmap (JPEG image)
     REM. The image will automatically be converted to the format (32bpp ARGB) required by GFXLIB
     bm% = FNLoadImg( @dir$ + "apple_400x400.JPG", 0 )


     REM. Set up a bitmap buffer of sufficient size to contain a 32bpp 640x512 bitmap
     bm2% = FNmalloc( 4*640*512 )


     REM. Declare the colour table structure
     DIM table{(255) b&, g&, r&, a&}


     REM. bmW% and bmH% must be the bitmap's actual width and height
     bmW% = 400
     bmH% = 400


     REM. Get base address of dispVars struct into D% (for slightly more access speed)
     D% = dispVars{}


     REM. Disable the automatic window refresh
     *REFRESH OFF


     REPEAT

       SYS GFXLIB_Clr%, dispVars{}, FNrgb( 255, 255, 255 )

       T% = TIME

       newBmH% = bmH% + 100*SIN(T%/35)*COS(T%/56)

       bmX% = (WinW% - bmW%) DIV 2
       bmY% = (WinH% - newBmH%) DIV 2

       REM. dx is the time-varying X displacement of the middle point of the quadratic curve
       dx = 1.6 * (newBmH% - bmH%)


       REM. Set up our quadratic curve coordinates
       REM. (x1,y1),  (x2,y2),  (x3,y3)
       x1 = bmX%
       y1 = bmY%

       x2 = x1 + dx
       y2 = y1 + newBmH%DIV2

       x3 = x1
       y3 = y1 + newBmH%


       REM. Our quadratic curve is of the form X = aY^2 + bY + c
       REM. We now need to compute a, b and c
       PROCgetQuadraticCoeffs( y1, x1, y2, x2, y3, x3, a, b, c )


       REM. Some "pre-calculations" (to improve loop efficiency)
       REM. Sorry if this appears rather cryptic
       hScale% = newBmH% / bmH%
       bmW4% = 4 * bmW%
       x2`% = 2*bmX% + bmW%
       dy% = y3 - bmY%
       s = bmH% / dy%


       REM. Now draw the scaled rows of pixels from the bitmap
       SYS GFXLIB_SaveDispVars%, dispVars{}
       SYS GFXLIB_SetDispVars2%, dispVars{}, bm2%, 640, 512
       SYS GFXLIB_Clr%, dispVars{}, 0
       REM. Draw the individual scaled rows of pixels from the bitmap
       FOR Y% = y1 TO y3-1

         REM. Calculate the base address of a row of pixels
         pRow% = bm% + bmW4% * INT(s*(Y%-bmY%))

         REM. Calculate the X-coordinate of the row
         X = a*Y%^2 + b*Y% + c

         REM. Calculate the width of the row
         rowWidth% = x2`% - 2*X

         REM. Draw the row of pixels
         SYS GFXLIB_BPlotScaleNC%, D%, pRow%, bmW%, 1, rowWidth%, hScale%+1, X, Y%

       NEXT
       SYS GFXLIB_RestoreDispVars%, dispVars{}


       REM. Display the rotated and scaled stretched/squashed apple bitmap
       SYS GFXLIB_PlotRotateScale2%, dispVars{}, bm2%, 640, 512, WinW%DIV2, WinH%DIV2, \
       \ &10000*360*SIN(T%/400), &10000*(0.5 + ABS(2.5*SIN(T%/2500)*COS(T%/3371)))


       REM. Set up the colour table for GFXLIB_ChangeBitmapRGBLevels
       FOR I% = 0 TO 255
         t# = 2*PI * I%/255
         table{(I%)}.r& = 128 + 127*SIN(t# + T%/180)
         table{(I%)}.g& = 128 + 127*COS(t# - T%/170)
         table{(I%)}.b& = 128 + 127*SIN(t# + T%/160)*COS(t# - T%/220)
       NEXT I%


       REM. Perform the gradual "colour morphing"
       SYS GFXLIB_ChangeBitmapRGBLevels%, dispVars.bmBuffAddr%, dispVars.bmBuffAddr%, WinW%*WinH%, ^table{(0)}.b&


       REM. Render the completed image to the program window
       PROCdisplay

     UNTIL FALSE


     DEF PROCgetQuadraticCoeffs( x1, y1, x2, y2, x3, y3, RETURN a, RETURN b, RETURN c )
     PROCsolve2x2( x1^2-x2^2, x1-x2, y1-y2, \
     \ x1^2-x3^2, x1-x3, y1-y3, \
     \ a, b )
     c = y1 - (a*x1^2 + b*x1)
     ENDPROC


     DEF PROCsolve2x2(A, B, C, D, E, F, RETURN x, RETURN y)
     LOCAL d
     d = (A*E - B*D)^-1
     x = d * (E*C - B*F)
     y = d * (A*F - D*C)
     ENDPROC


     DEF PROCfixWindowSize
     LOCAL GWL_STYLE, WS_THICKFRAME, WS_MAXIMIZEBOX, ws%
     GWL_STYLE = -16
     WS_THICKFRAME = &40000
     WS_MAXIMIZEBOX = &10000
     SYS "GetWindowLong", @hwnd%, GWL_STYLE TO ws%
     SYS "SetWindowLong", @hwnd%, GWL_STYLE, ws% AND NOT (WS_THICKFRAME+WS_MAXIMIZEBOX)
     ENDPROC


     DEF PROCerror( msg$, L% )
     OSCLI "REFRESH ON" : ON
     COLOUR 1, &FF, &FF, &FF
     COLOUR 1
     PRINT TAB(1,1)msg$;
     IF L% THEN
       PRINT " at line "; ERL;
     ENDIF
     VDU 7
     REPEAT UNTIL INKEY(1)=0
     ENDPROC