!  Amiga Animation routines
!
!  a True BASIC, Inc. product
!
!  Copyright (c) 1986 by True BASIC, Inc.
!  All rights reserved.
!
!  This library requires routines from amiga*, and the native-code
!  animation support routine s_animate.
!

EXTERNAL

SUB initanimation
    CALL s_animate(0,"",0,0,0,"")
END SUB

SUB endanimation
    CALL s_animate(1,"",0,0,0,"")
END SUB

DEF makebob(image$,x,y)
    CALL packb(w$,1,32,0)
    CALL s_animate(3,w$,x,y,result,image$)
    IF result = -1 then
       CAUSE EXCEPTION 700,"Not enough memory for object image."
    ELSE if result = -2 then
       CAUSE EXCEPTION 701,"Image string must be a BOX KEEP type string."
    END IF
    LET makebob = Unpackb(w$,1,-32)
END DEF

DEF makesprite(image$,sprite,x,y)
    IF unpackb(image$,33,16) <> 2 then
       CAUSE EXCEPTION 702,"Image is too wide for a Sprite-type object."
    END IF
    CALL packb(w$,1,32,0)
    LET result = sprite
    CALL s_animate(2,w$,x,y,result,image$)
    IF result = -1 then
       CAUSE EXCEPTION 700,"Not enough memory for object image."
    ELSE if result = -2 then
       CAUSE EXCEPTION 701,"Image string must be a BOX KEEP type string."
    ELSE if result = -3 then
       CAUSE EXCEPTION 703,"Couldn't allocate sprite #" & Str$(sprite) & "."
    END IF
    IF result<>0 then CAUSE EXCEPTION 5000
    LET makesprite = Unpackb(w$,1,-32)
END DEF

SUB destroyob(ob)
    CALL packl(ob,w$)
    CALL s_animate(4,w$,0,0,0,"")
END SUB

SUB animate_all(n,ob1,ob2)
    CALL packb(w$,1,32,0)
    CALL packb(s$,1,32,0)
    CALL s_animate(6,w$,n,0,0,s$)
    LET ob1 = unpackb(w$,1,-32)
    LET ob2 = unpackb(s$,1,-32)
END SUB

SUB animate_quick(n)
    CALL s_animate(5,"",n,0,0,"")
END SUB

SUB getbob_priority(ob,priority)
    DECLARE DEF peekw, upeekl
    LET vs = upeekl(ob+20)
    IF vs = 0 then
       CAUSE EXCEPTION 704,"Can't use this routine on a Sprite-type object."
    END IF
    LET priority = peekw(upeekl(vs+52)+30)
END SUB

SUB setbob_priority(ob,priority)
    DECLARE DEF upeekl
    IF upeekl(ob+20) = 0 then
       CAUSE EXCEPTION 704,"Can't use this routine on a Sprite-type object."
    END IF
    CALL packl(ob,w$)
    CALL s_animate(7,w$,priority,0,0,"")
END SUB

SUB getbob_flags(ob,PAINTBRUSH,SEETHRU)
    DECLARE DEF upeekb, upeekl
    LET vs = upeekl(ob+20)
    IF vs = 0 then
       CAUSE EXCEPTION 704,"Can't use this routine on a Sprite-type object."
    END IF
    LET vsflags = upeekb(vs+21)
    IF mod(vsflags,8) >= 4 then LET SEETHRU = 1 else LET SEETHRU = 0
    IF mod(vsflags,4) >= 2 then LET PAINTBRUSH = 0 else LET PAINTBRUSH = 1
END SUB

SUB setbob_flags(ob,PAINTBRUSH,SEETHRU)
    DECLARE DEF upeekb, upeekl
    LET vs = upeekl(ob+20)
    IF vs = 0 then
       CAUSE EXCEPTION 704,"Can't use this routine on a Sprite-type object."
    END IF
    LET vsflags = upeekb(vs+21)
    LET bob = upeekl(vs+52)
    LET bobflags = upeekb(bob+1)
    IF SEETHRU = 0 then
       IF mod(vsflags,8) >= 4 then LET vsflags = vsflags - 4
    ELSE
       IF mod(vsflags,8) < 4 then LET vsflags = vsflags + 4
    END IF
    IF PAINTBRUSH = 0 then
       IF mod(vsflags,8) < 2 then
          LET vsflags = vsflags + 2
          LET bobflags = bobflags - 1
       END IF
    ELSE
       IF mod(vsflags,4) >= 2 then
          LET vsflags = vsflags - 2
          LET bobflags = bobflags + 1
       END IF
    END IF
    CALL pokeb(bob+1,bobflags)
    CALL pokeb(vs+21,vsflags)
END SUB

SUB getbob_plane(ob,PlanePick,PlaneOnOff)
    DECLARE DEF upeekb, upeekl
    LET vs = upeekl(ob+20)
    IF vs = 0 then
       CAUSE EXCEPTION 704,"Can't use this routine on a Sprite-type object."
    END IF
    LET PlanePick = upeekb(vs+56)
    LET PlaneOnOff = upeekb(vs+57)
END SUB

SUB setbob_plane(ob,PlanePick,PlaneOnOff)
    DECLARE DEF upeekl
    LET vs = upeekl(ob+20)
    IF vs = 0 then
       CAUSE EXCEPTION 704,"Can't use this routine on a Sprite-type object."
    END IF
    CALL pokeb(vs+56,PlanePick)
    CALL pokeb(vs+57,PlaneOnOff)
END SUB

SUB getsprite_color(ob,color,R,G,B)
    DECLARE DEF upeekl
    IF upeekl(ob+20) <> 0 then
       CAUSE EXCEPTION 705,"Can't use this routine on a Bob-type object."
    END IF
    CALL packb(w$,1,32,ob)
    CALL s_animate(8,w$,color,cmix,0,"")
    CALL divide(cmix,16,cmix,myb)
    CALL divide(cmix,16,myr,myg)
    LET R = myr/15
    LET G = myg/15
    LET B = myb/15
END SUB

SUB setsprite_color(ob,color,R,G,B)
    DECLARE DEF upeekl
    IF upeekl(ob+20) <> 0 then
       CAUSE EXCEPTION 705,"Can't use this routine on a Bob-type object."
    END IF
    LET myr = max(0,min(15,round(R*15)))
    LET myg = max(0,min(15,round(G*15)))
    LET myb = max(0,min(15,round(B*15)))
    LET cmix = myr*256+myg*16+myb
    CALL packb(w$,1,32,ob)
    CALL s_animate(9,w$,color,cmix,0,"")
END SUB

SUB getob_mouse(ob,FOLLOWX,FOLLOWY)
    DECLARE DEF peekb
    LET FOLLOWX = peekb(ob+32)
    LET FOLLOWY = peekb(ob+33)
END SUB

SUB setob_mouse(ob,FOLLOWX,FOLLOWY)
    IF FOLLOWX = 0 then CALL pokeb(ob+32,0) else CALL pokeb(ob+32,1)
    IF FOLLOWY = 0 then CALL pokeb(ob+33,0) else CALL pokeb(ob+33,1)
END SUB

SUB getob_mask(ob,HitMask,MeMask)
    DECLARE DEF upeekw
    LET HitMask = upeekw(ob+28)
    LET MeMask = upeekw(ob+30)
END SUB

SUB setob_mask(ob,HitMask,MeMask)
    CALL pokew(ob+28,HitMask)
    CALL pokew(ob+30,MeMask)
END SUB

SUB getob_loc(ob,X,Y)
    DECLARE DEF peekw
    LET X = peekw(ob)
    LET Y = peekw(ob+2)
END SUB

SUB setob_loc(ob,X,Y)
    CALL pokew(ob,X)
    CALL pokew(ob+2,Y)
END SUB

SUB getob_vel(ob,XVel,YVel)
    DECLARE DEF peekw
    LET XVel = peekw(ob+4)
    LET YVel = peekw(ob+6)
END SUB

SUB setob_vel(ob,XVel,YVel)
    CALL pokew(ob+4,XVel)
    CALL pokew(ob+6,YVel)
END SUB

SUB getob_accel(ob,XAccel,YAccel)
    DECLARE DEF peekw
    LET XAccel = peekw(ob+8)
    LET YAccel = peekw(ob+10)
END SUB

SUB setob_accel(ob,XAccel,YAccel)
    CALL pokew(ob+8,XAccel)
    CALL pokew(ob+10,YAccel)
END SUB

SUB getborder(left,right,top,bottom)
    DECLARE DEF CurrentWindow,peekw,upeekl
    LET rp = upeekl(CurrentWindow+46)+84
    LET gi = upeekl(rp+20)
    LET left = peekw(gi+22)
    LET right = peekw(gi+24)
    LET top = peekw(gi+26)
    LET bottom = peekw(gi+28)
END SUB

SUB setborder(left,right,top,bottom)
    DECLARE DEF CurrentWindow,upeekl
    LET rp = upeekl(CurrentWindow+46)+84
    LET gi = upeekl(rp+20)
    CALL pokew(gi+22,left)
    CALL pokew(gi+24,right)
    CALL pokew(gi+26,top)
    CALL pokew(gi+28,bottom)
END SUB