Paste number 16539: WebKit demo

Paste number 16539: WebKit demo
Pasted by: slava
When:11 years, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+CRF
Channel:#concatenative
Paste contents:
Raw Source | XML | Display As
IN: webkit-test
USING: alien compiler io kernel math objc parser sequences ;

! Very rough Cocoa bridge demo.

! Problems:
! - does not release many objects; need to support autorelease
! - you cannot return to the REPL after, because we don't
!   support Cocoa events yet.

! Core Foundation utilities -- will be moved elsewhere
: kCFURLPOSIXPathStyle 0 ;

: kCFStringEncodingMacRoman 0 ;

FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ; compiled

FUNCTION: void* CFURLCreateWithString ( void* allocator, void* string, void* base ) ; compiled

FUNCTION: void* CFStringCreateWithCString ( void* allocator, char* cStr, int encoding ) ; compiled

FUNCTION: void* CFBundleCreate ( void* allocator, void* bundleURL ) ; compiled

FUNCTION: void* CFBundleGetFunctionPointerForName ( void* bundle, void* functionName ) ; compiled

FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ; compiled

FUNCTION: void CFRelease ( void* cf ) ; compiled

: <CFString> ( string -- cf )
    f swap kCFStringEncodingMacRoman CFStringCreateWithCString ;

: <CFFileSystemURL> ( string dir? -- cf )
    >r <CFString> f over kCFURLPOSIXPathStyle
    r> CFURLCreateWithFileSystemPath swap CFRelease ;

: <CFURL> ( string -- cf )
    <CFString>
    [ f swap f CFURLCreateWithString ] keep
    CFRelease ;

: <CFBundle> ( string -- cf )
    t <CFFileSystemURL> f over CFBundleCreate swap CFRelease ;

! Cocoa, WebKit classes and messages

! We do this at parse time so that the following code can see
! the new words
: init-cocoa
    "/System/Library/Frameworks/WebKit.framework" <CFBundle>
    CFBundleLoadExecutable drop
    {
        "NSObject" "NSWindow"
        "NSURLRequest" "NSApplication" "%NSURL"
        "WebView" "WebFrame"
    } [ dup define-objc-class "objc-" swap append use+ ] each ;
    parsing

init-cocoa

! This will move elsewhere really soon...
BEGIN-STRUCT: NSRect
    FIELD: float x
    FIELD: float y
    FIELD: float w
    FIELD: float h
END-STRUCT

TYPEDEF: NSRect _NSRect

: <NSRect>
    "NSRect" <c-object>
    [ set-NSRect-h ] keep
    [ set-NSRect-w ] keep
    [ set-NSRect-y ] keep
    [ set-NSRect-x ] keep ;

: NSBorderlessWindowMask     0 ; inline
: NSTitledWindowMask         1 ; inline
: NSClosableWindowMask       2 ; inline
: NSMiniaturizableWindowMask 4 ; inline
: NSResizableWindowMask      8 ; inline

: NSBackingStoreRetained    0 ; inline
: NSBackingStoreNonretained 1 ; inline
: NSBackingStoreBuffered    2 ; inline

: <NSURLRequest> ( string -- id )
    NSURLRequest swap <CFURL> [requestWithURL:] ;

! The ugliest colon definition ever
: webkit-test
    NSWindow [alloc]
    10 10 600 600 <NSRect>
    NSTitledWindowMask NSClosableWindowMask NSMiniaturizableWindowMask NSResizableWindowMask bitor bitor bitor
    NSBackingStoreBuffered 1 [initWithContentRect:styleMask:backing:defer:]
    dup "Hello world" <CFString> [setTitle:]
    dup
    
    WebView [alloc] 10 10 600 600 <NSRect> f f [initWithFrame:frameName:groupName:]
    
    dup [mainFrame] "http://factorcode.org" <NSURLRequest> [loadRequest:]
    
    [setContentView:]
    
    dup f [makeKeyAndOrderFront:]
    NSApplication [sharedApplication] [run] ;

\ webkit-test compile

webkit-test

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.