joelreymont

instance CoreTransform Expr C.Expr where
  toCore (Int x) = return $ C.Int x
  toCore (Double x) = return $ C.Double x
  toCore (Str x) = return $ C.Str x
  toCore (Bool x) = return $ C.Bool x
  toCore (Group x) = liftM C.Group (toCore x)
  toCore (UnOp UniMinus e) = liftM C.UniMinus (toCore e)
  toCore (UnOp Not e) = liftM C.Not (toCore e)
  toCore (Op Minus e1 e2) = liftM2 C.Minus (toCore e1) (toCore e2)
  toCore (Op Plus e1 e2) = liftM2 C.Plus (toCore e1) (toCore e2)

joelreymont

(define-strategy ((ema-length 20) ; strategy inputs
                (patience-threshold 5) ; can have default values
                (points-target 1.5)
                (points-risked 2))
  ;; declare variables
  (let ((x-up 0) (x-down 0)
        (factor1 0) (factor2 0)
        (factor3 0) (factor4 0))
    ;; set things up
    (set factor1 (* (- (high) (low)) 2.5)

joelreymont

(defun cocoa-build-sprite (sprite image mask size)
  (declare #.*optimize*
           (type fixnum size))
  (fli:with-coerced-pointer
      (sp :type '(:foreign-array :byte (10000000))) sprite
      (fli:with-coerced-pointer
          (ip :type '(:foreign-array :byte (10000000))) image
          (loop for i fixnum from 0 below (* size 3) by 3
             for j from 3 by 3
             for alpha from 3 by 4 do

joelreymont

(defun cocoa-build-sprite (sprite image mask size)
  (declare #.*optimize*
           (type fixnum size))
  (let ((sp (fli:copy-pointer sprite))
        (ip (fli:copy-pointer image))
        (mp (fli:copy-pointer mask)))
    (loop for i fixnum from 0 below size do
       ;; copy red
         (setf (fli:dereference sp)
               (the fixnum (fli:dereference ip)))

joelreymont

(defun cocoa-build-sprite (sprite image mask size)
  (declare #.*optimize*
           (type fixnum size))
  (loop for i fixnum from 0 below size
     for ii fixnum from 0 by 3
     for si fixnum from 0 by 4
     for alpha fixnum = ii
     for sr fixnum = si
     for sg fixnum = (1+ sr)
     for sb fixnum = (1+ sg)

joelreymont

-module(arr).

-compile([export_all]).

data1(N) ->
    %% size implies fixed-size array 
    %% but lets be explicit
    array:new([{size, N}, {default, 0}, {fixed, true}]).

data2(N) ->

joelreymont

;;; quick and dirty C++ style overloading (assuming SBCL/CMUCL)
;;;
;;; disassemble FOO to verify that it doesn not go thu FROB, 
;;; but calls %FROB-SINGLE-FLOAT directly
;;;

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *frob-specs* nil))

(defmacro deffrob (type lambda-list &body body)

joelreymont

;; retrieve raw image data

(multiple-value-bind (background-bitmap background-data)
    (cocoa-get-image-bytes ns-background)
  (multiple-value-bind (image-bitmap image-data)
      (cocoa-get-image-bytes ns-image)
    (multiple-value-bind (mask-bitmap mask-data)
        (cocoa-get-image-bytes ns-mask)

      (cocoa-blend background-data 

joelreymont

;;; Blend a masked source image with a target

(defun cocoa-blend (target source mask offset size)
  (declare #.*optimize*
           (type fixnum size offset)
           (inline fli:dereference (setf fli:dereference)))
  (loop for i fixnum from offset below (the fixnum (+ offset size)) 
     for j fixnum from 0 below size do

       (let ((dst (fli:dereference target :index i :type '(:unsigned :char)))

joelreymont

;;; Blend a masked source image with a target

(defun cocoa-blend (target source mask offset size)
  (declare #.*optimize*
           (type fixnum size offset)
           (inline fli:dereference (setf fli:dereference)))
  (loop for i fixnum from offset below (the fixnum (+ offset size)) 
     for j fixnum from 0 below size do

       (let ((dst (fli:dereference target :index i :type '(:unsigned :char)))