;;; proxy testing

(use objc)
(require-library typetest)

(objc:add-method TypeTest "testd:i:" (list objc:INT objc:ID objc:SEL objc:DBL objc:INT)
                 (lambda (self sel d i)
                   (print "d " d " i " i)
                   (+ (+ d 0.5) i)))
(objc:add-method TypeTest "testi:f:d1:c1:c2:d2:"
                 (list objc:DBL objc:ID objc:SEL objc:INT objc:FLT objc:DBL objc:CHR objc:CHR objc:DBL)
                 (lambda (self sel i f d1 c1 c2 d2)
                   (printf "i ~s f ~s d1 ~s c1 ~s c2 ~s d2 ~s\n" i f d1 c1 c2 d2)
                   3.8))
(objc:define-method TypeTest BOOL ((tests: SHT s)
                                   (S:     USHT us)
                                   (bool:  BOOL b)
                                   (class: CLASS c))
                    (printf "self ~s sel ~s s ~s us ~s b ~s c ~s\n" self sel s us b c)
                    #t)
(objc:define-method TypeTest ID selfprint (printf "self ~s\n" self) self)

(objc:add-class-method TypeTest "test3s:S:bool:class:" (list objc:SHT objc:CLASS objc:SEL objc:SHT objc:USHT objc:BOOL objc:CLASS) (lambda (self sel s us b c) (printf "self ~s sel ~s s ~s us ~s b ~s c ~s\n" self sel s us b c) -1))

(define-objc-class MyPoint NSObject ((DBL x) (DBL y))
  (define-method ID  init (print "MyPoint init") self)
  (define-method DBL getX (ivar-ref self x))
  (define-method DBL getY (ivar-ref self y))
  (define-method VOID print
    (print "("  (ivar-ref self x)
           ", " (ivar-ref self y) ")"))
  (define-method VOID ((moveByX: DBL a) (Y: DBL b))
    (ivar-set! self x (+ a (ivar-ref self x)))
    (ivar-set! self y (+ b (ivar-ref self y))))
;  (- VOID dealloc (print "deallocating " self)) ;; temporary
  )

;; This is here because there was previously memory corruption upon
;; adding many methods (now fixed).
(define-objc-class MethTest NSObject ()
  (- ID  init
     @[super init]
     (print "MethTest init")
     self)
  (- ID  test (print "methtest") self)
  (- ID  test2 (gc) (print "methtest") self)
  (- ID  test3 (print "methtest") self)
  (- ID  test4 (print "methtest") self)
  (- ID  test5 (print "methtest") self)
  (- ID  test6 (print "methtest") self)
  (- ID  test7 (print "methtest") self)
  (- ID  test8 (print "methtest") self)
  (- ID  test9 (print "methtest") self)
  (- ID  test10 (print "methtest") self)
  (- ID  test11 (print "methtest") self)
  (- ID  test12 (print "methtest") self)
  (- VOID  ((printArg: ID arg))
     ;(gc #t)
     (print @[arg retainCount])
     ;(print @[arg length])
     (void))
  (- VOID  ((printDArg: DBL arg))
     ;(gc #t)
     ;(print @[arg retainCount])
     ;(print @[arg length]))
     (void))

 (+ ID  newobject @[MethTest alloc])
  ;(- VOID dealloc (print "deallocating " self)
     ;@[super dealloc]     ;; crash
;     )
)

(define-objc-class Base NSObject ((CHR c))
  (+ ID description   ;; Description for class.
     (print "Base: super description: "); @[super description])
     @"{Base}")
  (+ ID ((test: INT i))
     (print "Base test" i)
     @"test"
     )
  (- ID ((test: FLT i))
     (print "Base test" i)
     @"test"
     )
     
  (- ID description   ;; Description for instances.
     (sprintf "<Base instance at 0x~x: char ~s>"
                             (pointer->address
                              (objc:instance->pointer self))
                             (ivar-ref self c)))
  (- ID init
     @[super init]
     (print "Base: init.")
     (ivar-set! self c #\&)
     self))

(define-objc-class Subclass Base ()
  (+ ID description
     (print "Subclass: super description: " @[super description])
     @"[Subclass]")
  (+ ID ((test: DBL i))
     @[super test: i]
     (print "Subclass test" i)
     @"test")

  (- ID init
     @[super init]
     (print "Subclass: init.")
     self)
  ;(- VOID dealloc
  ;   (print "Deallocating subclass"))
  )

     
(define o @[ @[TypeTest alloc] init])
@[o testi: 1.1 f: 2.2 d1: 3.3 c1: #\c c2: #\d d2: 4.4]
@[o tests: -1 S: -1 bool: #t class: TypeTest]
@[TypeTest test3s: -1 S: -1 bool: #t class: TypeTest]
@[o selfprint]

(define p @[ @[MyPoint alloc] init])
(ivar-set! p x 5.3)
(ivar-set! p y 7.7)
@[p moveByX: 1.1 Y: 2.2]
@[p print]  ;; (6.4, 9.9)


;; Base/subclass tests

@[Subclass description]  ;; prints the following:
;; Base: super description: @"Subclass"     <=== Default NSObject description
;; Subclass: super description: @"{Base}"   <=== return value from Base::description
;; @"[Subclass]"                            <=== return value from Subclass:description

(define s @[ @[Subclass alloc] init])       ;; prints "Base: init" then "Subclass: init"
s               ; => #<objc-instance <Base instance at 0x112a800: char #\&>>
(ivar-ref s c)  ; => #\&