[futurebasic] FB Examples broken as of FB's current ( 5.7.99 ) release

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : March 2017 : Group Archive : Group : All Groups

From: Ken Shmidheiser <kshmidheiser@...>
Date: Thu, 30 Mar 2017 03:21:13 -0400
Brian wrote:

Brian wrote:

> It might be easy to update some of these( by simply swapping out an FSSpec for a CFURL ) but others ( such as CGBlend ) have additional older tech also needing an update. 



This should fix GBlend.

Ken


/*
  Written by S. Van Voorst
  FBtoC    {7/28/07}
  Revised   {20091024}
  Revised   {20170330}  KS
*/

include "Tlbx HIView.incl"
include "Tlbx CoreGraphics.incl"


_kGraphicsImportCreateCGImageUsingCurrentSettings = 1 << 0

/*begin enum//CGBlendMode 
_kCGBlendModeNormal
_kCGBlendModeMultiply
_kCGBlendModeScreen
_kCGBlendModeOverlay
_kCGBlendModeDarken
_kCGBlendModeLighten
_kCGBlendModeColorDodge
_kCGBlendModeColorBurn
_kCGBlendModeSoftLight
_kCGBlendModeHardLight
_kCGBlendModeDifference
_kCGBlendModeExclusion
_kCGBlendModeHue
_kCGBlendModeSaturation
_kCGBlendModeColor
_kCGBlendModeLuminosity
end enum*/

begin enum 1
_pane
_importBtn
_quitBtn
_rColorLabel
_gColorLabel
_bColorLabel
_alphaLabel
_rColorDisplay
_gColorDisplay
_bColorDisplay
_alphaDisplay
_rArrwBtn
_gArrwBtn
_bArrwBtn
_alphaArrwBtn
end enum

_redMin = 0
_redMax = 100
_redInit = 80

_greenMin = 0
_greenMax = 100
_greenInit = 0

_blueMin = 0
_blueMax = 100
_blueInit = 0

_alphaMin = 0
_alphaMax = 100
_alphaInit = 100


begin globals
dim as CGImageRef    gImage
end globals

Toolbox fn  GraphicsImportCreateCGImage( GraphicsImportComponent  ci, CGImageRef * imageRefOut, UInt32   flags ) = ComponentResult

local fn  importImage
'~'1
dim as CFURLRef           myImageCFURLRef
dim as Str255             fname$

fname$ = files$( _CFURLRefOpen, "PICTTIFFGIFFJPEG", "Choose image..", myImageCFURLRef )
long if len( fname$ )'Make sure a file was selected.
BeginCcode
CGImageSourceRef tmpImageSource = CGImageSourceCreateWithURL( myImageCFURLRef, NULL );
CFDictionaryRef isProperties = CGImageSourceCopyProperties( tmpImageSource, NULL );
CFRelease( isProperties );
gImage = CGImageSourceCreateImageAtIndex( tmpImageSource, 0, NULL );
CFRelease( tmpImageSource );
EndC
end if

end fn 

local fn  displayInitValues
'~'1
fn SetButtonTextString( _rColorDisplay, str$(_redInit/100.0) )
fn SetButtonTextString( _gColorDisplay, str$(_greenInit/100.0) )
fn SetButtonTextString( _bColorDisplay, str$(_blueInit/100.0) )
fn SetButtonTextString( _alphaDisplay, str$(_alphaInit/100.0) )
end fn 

local fn  LittleArrowsAction( c as ControlRef, partCode as short )
'~'1
dim as long  prev

prev = fn  GetControlValue( c )
select partCode

case _kControlUpButtonPart
long if ( fn  GetControlMaximum( c ) > prev )
SetControlValue( c, prev + 1 )

select c

case button&( _rArrwBtn )
fn SetButtonTextString( _rColorDisplay, str$( button( _rArrwBtn )/100.0) )

case button&( _gArrwBtn )
fn SetButtonTextString( _gColorDisplay, str$( button( _gArrwBtn )/100.0) )

case button&( _bArrwBtn )
fn SetButtonTextString( _bColorDisplay, str$( button( _bArrwBtn )/100.0) )

case button&(_alphaArrwBtn)
fn SetButtonTextString( _alphaDisplay, str$( button( _alphaArrwBtn )/100.0) )

end select
fn  HIViewSetNeedsDisplay( button&( _pane ), _true )
end if

case _kControlDownButtonPart
long if ( fn  GetControlMinimum( c ) < prev )
SetControlValue( c, prev - 1 )

select c

case button&( _rArrwBtn )
fn SetButtonTextString( _rColorDisplay, str$( button( _rArrwBtn )/100.0) )

case button&( _gArrwBtn )
fn SetButtonTextString( _gColorDisplay, str$( button( _gArrwBtn )/100.0) )

case button&( _bArrwBtn )
fn SetButtonTextString( _bColorDisplay, str$( button( _bArrwBtn )/100.0) )

case button&(_alphaArrwBtn)
fn SetButtonTextString( _alphaDisplay, str$( button( _alphaArrwBtn )/100.0) )

end select

fn  HIViewSetNeedsDisplay( button&( _pane ), _true )

end if
end select
end fn

local fn  InstallLittleArrowsAction( c as ControlRef )
'~'1
SetControlAction( c, @fn LittleArrowsAction )
end fn  


local fn  WindowEventHandler( nextHandler as EventHandlerCallRef, theEvent as EventRef, userData as Ptr ) as OSStatus
'~'1
dim as WindowRef    @ w
dim as UInt32       eventClass, eventKind
dim as OSStatus     result
dim as ControlRef   @ controlRef

result = _eventNotHandledErr

eventKind  = fn  GetEventKind( theEvent )
eventClass = fn  GetEventClass( theEvent )

select eventClass

case _kEventClassWindow
fn  GetEventParameter( theEvent, _kEventParamDirectObject, _typeWindowRef, #0, sizeof( WindowRef ), #0, @w )

select eventKind

case _kEventWindowClose
CGImageRelease ( gImage )

end select

case _kEventClassControl
fn  GetEventParameter( theEvent, _kEventParamDirectObject, _typeControlRef, #0, sizeof( controlRef ), #0, @controlRef )

select eventKind

case _kEventControlHit

select controlRef

case button&(_importBtn)

fn  importImage
fn  HIViewSetNeedsDisplay( button&( _pane ), _true)

case button&(_quitBtn)

CGImageRelease ( gImage )
end

 end select

end select

end select

end fn = result

local fn  InstallWindowHandler( w as WindowRef )
'~'1
_nWndEvnts = 2

dim as EventTypeSpec  ev(_nWndEvnts - 1)

ev.eventClass(0) = _kEventClassWindow
ev.eventKind(0)  = _kEventWindowClose

ev.eventClass(1) = _kEventClassControl
ev.eventKind(1)  = _kEventControlHit

end fn = fn  InstallEventHandler( fn  GetWindowEventTarget( w ), @fn WindowEventHandler, _nWndEvnts, @ev(0), #0, #0 )


local fn  PaneDrawHandler( nextHandler as EventHandlerCallRef, theEvent as EventRef, userData as Ptr ) as OSStatus
'~'1
dim as ControlRef   @ c
Dim As CGContextRef @ ctx
dim as OSStatus    err
dim as CGrafPtr    @ oldPort, controlPort
dim as Ptr       @ themeState
dim as HIRect     bounds
dim as CGRect   myRect, imageRect
Dim as long  @ pixelWidth, pixelHeight
dim as single aspectRatio

// Create ContextRef
fn  GetEventParameter( theEvent, _kEventParamCGContextRef, _typeCGContextRef, #0, sizeof( CGContextRef ), #0, @ctx )

// get the ControlRef
fn  GetEventParameter( theEvent, _kEventParamDirectObject, _typeControlRef, #0, sizeof( c ), #0, @c )

// make sure we draw in the correct port
GetPort( @oldPort )
err = fn  GetEventParameter( theEvent, _kEventParamGrafPort, _typeGrafPtr, #0, sizeof( CGrafPtr ), #0, @controlPort )
if ( err == _noErr ) then SetPort( controlPort )

// save the current pen and background color, pattern, etc
fn  GetThemeDrawingState( (ptr)@themeState )

// get the view-centric bounds of the control
fn  HIViewGetBounds( c, @bounds )

// So drawing will be right side up with bottom,left = 0,0
CGContextTranslateCTM( ctx, 0, bounds.size.height )
CGContextScaleCTM( ctx, 1.0, -1.0 )

// ------ Frame around user pane -------

CGContextSetRGBStrokeColor( ctx, 0, 0, 1, 1 )
CGContextStrokeRectWithWidth( ctx, bounds, 3 )

// ------- Drawing for Imported Images -------

CGContextSaveGState( ctx )

long if gImage != 0

pixelWidth = fn CGImageGetWidth( gImage )
pixelHeight = fn CGImageGetHeight( gImage )

imageRect.origin.x = 0
imageRect.origin.y = 0
imageRect.size.width = pixelWidth
imageRect.size.height = pixelHeight

aspectRatio = pixelWidth/pixelHeight

CGContextTranslateCTM( ctx, 5, 5 )

long if pixelWidth > pixelHeight
CGContextScaleCTM( ctx, 420.0*aspectRatio/pixelWidth, 420.0/pixelHeight)
xelse
CGContextScaleCTM( ctx, 460.0*aspectRatio/pixelWidth, 420.0/pixelHeight)
end if

CGContextDrawImage( ctx, imageRect, gImage)

CGContextSetBlendMode( ctx, _kCGBlendModeColor )

CGContextSetRGBFillColor( ctx, button(_rArrwBtn)/100.0, button(_gArrwBtn)/100.0, ¬
button(_bArrwBtn)/100.0, button( _alphaArrwBtn )/100.0 )

myRect.origin.x = 0.10*pixelWidth
myRect.origin.y = 0.10*pixelHeight
myRect.size.width = pixelWidth - 0.20*pixelWidth
myRect.size.height = pixelHeight - 0.20*pixelHeight

CGContextFillRect( ctx, myRect )

end if

CGContextRestoreGState( ctx )

// restore the drawing state
fn  SetThemeDrawingState( themeState, _true )
SetPort( oldPort )

end fn = _noErr

local fn  InstallPaneDrawHandler( c as ControlRef )
'~'1
dim as EventTypeSpec  ev

ev.eventClass = _kEventClassControl
ev.eventKind  = _kEventControlDraw

end fn  = fn  InstallEventHandler( fn  GetControlEventTarget( c ), @fn PaneDrawHandler, 1, @ev, #0, #0 )

local fn  BuildWindow
'~'1
dim as Rect        r
dim as WindowRef @ wRef
dim as WindowAttributes  attr
Dim as ControlFontStyleRec   cfs

_wndW = 710

attr  = _kWindowStandardFloatingAttributes
attr += _kWindowStandardHandlerAttribute
attr += _kWindowCompositingAttribute
attr += _kWindowMetalAttribute

SetRect( r, 30, 50, 740, 560 )
appearance window -1, @"BlendModeColor_demo",@r, _kDocumentWindowClass, ¬
attr

get window 1, wRef
fn  InstallWindowHandler( wRef )// intercept some window CarbonEvents

SetRect( r, 30, 50, _wndW - 30, 480 )
appearance button _pane,,,,,,@r,_kControlUserPaneProc
fn  InstallPaneDrawHandler(  button&(_pane) )

SetRect( r, _wndW - 250, 0, _wndW - 30, 20 )
appearance button _importBtn,,,,, @"Import PICTTIFFGIFFJPEG", @r, _kControlPushButtonProc

If ( System( _sysVers ) < 1030 ) then button #_importBtn, _grayBtn

SetRect( r, _wndW - 120, 25, _wndW - 30, 45 )
appearance button _quitBtn,,,,, @"Quit", @r, _kControlPushButtonProc

// ------ Red ------

SetRect( r, 30, 10, 58, 30 )
appearance button _rColorLabel,,,,,,@r, _kControlStaticTextProc
fn SetButtonTextString( _rColorLabel, "Red:" )

SetRect( r, 60, 10, 95, 27 )
appearance button _rColorDisplay,,,,,,@r, _kControlStaticTextProc
cfs.flags = _kControlUseFontMask + _kControlUseFaceMask + _kControlUseSizeMask¬
 + _kControlUseJustMask + _kControlUseForeColorMask
cfs.font = _geneva : cfs.size = 12 : cfs.style = _boldBit% + _ItalicBit% : cfs.just = _teFlushLeft
cfs.foreColor.red = -1 : cfs.foreColor.green = 0 : cfs.foreColor.blue = 0
fn SetButtonFontStyle( _rColorDisplay, cfs )

SetRect( r, 105, 10, 121, 31)
appearance button _rArrwBtn,_activeBtn,_redInit,_redMin,_redMax,,@r,¬
_kControlLittleArrowsProc
fn  InstallLittleArrowsAction( button&( _rArrwBtn ))

// ------ Green ------

SetRect( r, 130, 10, 170, 30 )
appearance button _gColorLabel,,,,,,@r, _kControlStaticTextProc
fn SetButtonTextString( _gColorLabel, "Green:" )

SetRect( r, 170, 10, 210, 27 )
appearance button _gColorDisplay,,,,,,@r, _kControlStaticTextProc
cfs.flags = _kControlUseFontMask + _kControlUseFaceMask + _kControlUseSizeMask¬
 + _kControlUseJustMask + _kControlUseForeColorMask
cfs.font = _geneva : cfs.size = 12 : cfs.style = _boldBit% + _ItalicBit% : cfs.just = _teFlushLeft
cfs.foreColor.red = -1 : cfs.foreColor.green = 0 : cfs.foreColor.blue = 0
fn SetButtonFontStyle( _gColorDisplay, cfs )

SetRect( r, 210, 10, 231, 31)
appearance button _gArrwBtn,_activeBtn,_greenInit,_greenMin,_greenMax,,@r,¬
_kControlLittleArrowsProc
fn  InstallLittleArrowsAction( button&( _gArrwBtn ))

// ------- Blue -------

SetRect( r, 235, 10, 265, 30 )
appearance button _bColorLabel,,,,,,@r, _kControlStaticTextProc
fn SetButtonTextString( _bColorLabel, "Blue:" )

SetRect( r, 265, 10, 305, 27 )
appearance button _bColorDisplay,,,,,,@r, _kControlStaticTextProc
cfs.flags = _kControlUseFontMask + _kControlUseFaceMask + _kControlUseSizeMask¬
 + _kControlUseJustMask + _kControlUseForeColorMask
cfs.font = _geneva : cfs.size = 12 : cfs.style = _boldBit% + _ItalicBit% : cfs.just = _teFlushLeft
cfs.foreColor.red = -1 : cfs.foreColor.green = 0 : cfs.foreColor.blue = 0
fn SetButtonFontStyle( _bColorDisplay, cfs )

SetRect( r, 310, 10, 326, 31)
appearance button _bArrwBtn,_activeBtn,_blueInit,_blueMin,_blueMax,,@r,¬
_kControlLittleArrowsProc
fn  InstallLittleArrowsAction( button&( _bArrwBtn ))

// ------- Alpha --------

SetRect( r, 335, 10, 375, 30 )
appearance button _alphaLabel,,,,,,@r, _kControlStaticTextProc
fn SetButtonTextString( _alphaLabel, "Alpha:" )

SetRect( r, 375, 10, 410, 27 )
appearance button _alphaDisplay,,,,,,@r, _kControlStaticTextProc
cfs.flags = _kControlUseFontMask + _kControlUseFaceMask + _kControlUseSizeMask¬
 + _kControlUseJustMask + _kControlUseForeColorMask
cfs.font = _geneva : cfs.size = 12 : cfs.style = _boldBit% + _ItalicBit% : cfs.just = _teFlushLeft
cfs.foreColor.red = -1 : cfs.foreColor.green = 0 : cfs.foreColor.blue = 0
fn SetButtonFontStyle( _alphaDisplay, cfs )

SetRect( r, 415, 10, 431, 31)
appearance button _alphaArrwBtn,_activeBtn,_alphaInit,_alphaMin,_alphaMax,,@r,¬
_kControlLittleArrowsProc
fn  InstallLittleArrowsAction( button&( _alphaArrwBtn ))

fn  displayInitValues

appearance window 1

end fn 

fn  BuildWindow

do
HandleEvents
until gFBQuit