home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / hbasic_1 / sprite / sprites.bas < prev   
Encoding:
BASIC Source File  |  1997-07-16  |  3.6 KB  |  197 lines
  1. rem $option y+,q30
  2. LIBRARY "GEMAES","GEMVDI","BIOS","XBIOS"
  3. defint a-z
  4. rem $include gemaes.bh
  5. rem $include sprite.bh
  6. DECLARE FUNCTION newform_alert(BYVAL button,BYVAL addr&)
  7.  
  8.  
  9. j=rsrc_load("SPRITE.RSC")
  10. IF j=0 THEN j2=form_alert(1,"[3][SPRITE.RSC][OK]") : SYSTEM
  11. j=wind_get(0,wf_workxywh,x,y,w,h)
  12. myco=win_name+win_close+win_move+win_full+win_size
  13. m_handle=wind_create(myco,x,y,w,h)
  14. j=rsrc_gaddr(5,window4,alert&) : j=newform_alert(1,alert&)
  15.  
  16.  
  17.  
  18.  
  19. j=rsrc_gaddr(5,title3,title&)
  20. j=wind_set(m_handle,wf_name,PEEKW(VARPTR(title&)),PEEKW(VARPTR(title&)+2),0,0)
  21. GOSUB initutil:
  22. j2=rsrc_gaddr(0,1,tree&)
  23.  
  24.  
  25. j=rsrc_gaddr(0,0,menu&)
  26. menu_bar menu&,1
  27.  
  28. j=wind_open(m_handle,x+(w/4),y+(h/4),w/2,h/2)
  29.  
  30. time&=100
  31.  
  32. main:
  33. e=evnt_multi(mu_mesag+mu_timer,c,m,s,1,x,y,w,h,2,x,y,w,h,VARPTR(mess(0)),time&,xout,yout,button,kstate,k,gt)
  34. if e and mu_mesag then do_message mess(0)
  35. IF e AND mu_timer THEN GOTO spriteutil:
  36. GOTO main:
  37.  
  38. endprog:
  39. j=rsrc_free
  40. menu_bar menu&,0
  41. SYSTEM
  42.  
  43.  
  44. SUB do_message(BYVAL mes_type)
  45. LOCAL title,item,j,j2,tt,x,y,w,h,x2,y2,w2,h2
  46. LOCAL xre,yre,wre,hre
  47. SHARED menu&,mess(0),m_handle,tree&,ob
  48. SELECT CASE mes_type
  49. CASE mn_selected 
  50. title=mess(3)
  51. item=mess(4)
  52. menu_tnormal menu&,title,1
  53. IF title=file AND item=quit THEN GOTO endprog:
  54.  
  55. CASE wm_closed
  56. j=wind_close(mess(3))
  57. j=wind_delete(mess(3))
  58.  
  59. IF mess(3)=m_handle THEN m_handle=0
  60. CASE wm_topped
  61. j=wind_set(mess(3),wf_top,tt,0,0,0)
  62. CASE wm_sized,wm_moved
  63.  
  64. 'j=wind_calc(1,myco,mess(4),mess(5),mess(6),mess(7),x_in,y_in,w_in,h_in)
  65. 'POKEW tree&+ob_sizeof*0+ob_x,x_in : REM set form to new value
  66. 'POKEW tree&+ob_sizeof*0+ob_y,y_in : REM set form to new value
  67. 'POKEW tree&+ob_sizeof*0+ob_width,w_in
  68. 'POKEW tree&+ob_sizeof*0+ob_height,h_in
  69. 'onlyreal:
  70.  
  71. j=wind_set(mess(3),wf_currxywh,mess(4),mess(5),mess(6),mess(7))
  72.  
  73. CASE wm_fulled
  74. j=wind_get(mess(3),wf_currxywh,x,y,w,h)
  75. j=wind_get(mess(3),wf_fullxywh,x2,y2,w2,h2)
  76. IF x=x2 AND y=y2 AND w=w2 AND h=h2 THEN
  77.     j=wind_get(mess(3),wf_prevxywh,x2,y2,w2,h2)
  78. END IF
  79. j=wind_set(mess(3),wf_currxywh,x2,y2,w2,h2)
  80.  
  81.  
  82.  
  83. CASE wm_redraw
  84. graf_mouse 256,0
  85.  
  86.  
  87. 'vs_clip 1,mess(4),mess(5),mess(6),mess(7)
  88. j=wind_get(mess(3),wf_firstxywh,xre,yre,wre,hre)
  89. DO
  90. IF wre=0 AND hre=0 THEN EXIT LOOP
  91.  
  92. j=wind_update(1)
  93. vsf_color 3
  94. vsf_interior 2
  95. vsf_style 4
  96. vr_recfl xre,yre,(xre+wre)-1,(yre+hre)-1
  97.  
  98. j=objc_draw(tree&,ob,0,xre,yre,wre,hre)
  99.  
  100.  
  101. j=wind_update(0)
  102.  
  103.  
  104.  
  105. j=wind_get(mess(3),wf_nextxywh,xre,yre,wre,hre)
  106. LOOP
  107. vs_clip 0,0,0,0,0
  108. graf_mouse 257,0
  109.  
  110.  
  111.  
  112. END SELECT
  113. END SUB
  114.  
  115.  
  116.  
  117. initutil:
  118. ix=10
  119. iy=10
  120. ob=1
  121. RETURN
  122.  
  123.  
  124.  
  125. spriteutil:
  126. IF m_handle<1 THEN GOTO main:
  127.  
  128.  
  129. j2=rsrc_gaddr(0,1,tree&)
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138. INCR ob : IF ob=4 THEN ob=1
  139.  
  140.  
  141.  
  142. graf_mkstate x,y,s,ks
  143.  
  144.  
  145. j=wind_get(m_handle,wf_workxywh,x2,y2,w2,h2)
  146.  
  147.  
  148. POKEW tree&+ob_sizeof*0+ob_x,x2
  149. POKEW tree&+ob_sizeof*0+ob_y,y2
  150.  
  151. REM x and y are offsets from the top left of the window
  152.  
  153.  
  154. POKEW tree&+ob_sizeof*ob+ob_x,ix
  155. POKEW tree&+ob_sizeof*ob+ob_y,iy
  156.  
  157. j=objc_offset(tree&,ob,x3,y3)
  158.  
  159. IF x3<x THEN dx=(x-x3)/16
  160. IF x3>x THEN dx=0-((x3-x)/16)
  161. IF y3<y THEN dy=(y-y3)/16
  162. IF y3>y THEN dy=0-((y3-y)/16)
  163.  
  164.  
  165.  
  166. IF (ix>w2) THEN ix=ix-4
  167. IF (ix<1)  THEN ix=ix+4
  168. IF (iy>h2) THEN iy=iy-4
  169. IF (iy<1)  THEN iy=iy+4
  170.  
  171.  
  172. IF (ix<w2) AND (ix>0) THEN ix=ix+dx
  173. IF (iy<h2) AND (iy>0) THEN iy=iy+dy
  174.  
  175.  
  176.  
  177. 'form_dial 3,0,0,0,0,oldsx,oldsy,32,32
  178.  
  179.  
  180. j=wind_get(m_handle,wf_workxywh,x,y,w,h)
  181. j=objc_draw(tree&,ob,0,x,y,w,h)
  182.  
  183. j=objc_offset(tree&,ob,sx,sy)
  184.  
  185.  
  186. GOTO main:
  187.  
  188. FUNCTION newform_alert(BYVAL button,BYVAL addr&)
  189. POKEW PEEKL(GB+8),button    'int_in
  190. POKEL PEEKL(GB+16),addr&    'addr_in
  191. GEMSYS(52)                    
  192. newform_alert%=PEEKW(PEEKL(GB+20))
  193. END FUNCTION
  194.  
  195.  
  196.  
  197.