home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / ac9_disk / tutorial.s / hbasic06.tut / pdo / pdo.bas < prev    next >
Encoding:
BASIC Source File  |  1998-03-10  |  4.4 KB  |  208 lines

  1.  
  2. REM PDO - Print Documents Out, the example project for the HBASIC
  3. REM       tutorial for Atari Computing by Paul Jones
  4.  
  5. LIBRARY "gemaes","gemvdi"
  6.  
  7. REM $option k10
  8. REM $option g,y+,v+,u+,#,[,]
  9.  
  10. DEFINT a-z
  11.  
  12. DIM SHARED junk
  13. REM DECLARE FUNCTION Dialog
  14.  
  15. REM $include pdo.bh
  16. REM $include gemaes.bh
  17.  
  18. DIM SHARED tree&
  19.  
  20. DEF FNObjectAddr&(object)=tree&+object*ob_sizeof
  21. DEF FNGetob_spec&(object)=PEEKL(FNObjectAddr&(object)+ob_spec)
  22.  
  23. SUB Exclob_state(object,flag_mask)
  24. STATIC t&
  25. t&=FNObjectAddr&(object)+ob_state
  26. POKEW    t&,PEEKW(t&) AND (NOT flag_mask)
  27. END SUB
  28.  
  29. SUB Sette_ptext(object,newted$)
  30. STATIC t&,chars,i,dum1,dum2
  31. t&=FNGetob_spec&(object)
  32.  
  33. dum1=peekw (t&+te_txtlen)-1
  34. dum2=len(newted$)
  35.  
  36. if dum1<dum2 then chars=dum1
  37. if dum2<dum1 then chars=dum2
  38.  
  39. t&=PEEKL(t&+te_ptext)
  40. FOR i=1 TO chars
  41.     POKEB t&,ASC(MID$(newted$,i,1))
  42.     INCR t&
  43. NEXT i
  44. POKEB t&,0
  45. END SUB
  46.  
  47. SUB SelectTreeAddr (t&)
  48. tree&=t&
  49. END SUB
  50.  
  51. SUB SelectTree (treeno)
  52. STATIC formaddr&
  53.     junk=FNrsrc_gaddr(type_tree,treeno,formaddr&)
  54.     SelectTreeAddr formaddr&
  55. END SUB
  56.  
  57. DEF FNGette_ptext$(object)
  58. STATIC t&,a$
  59. a$=""
  60. t&=FNGetob_spec&(object)
  61. t&=PEEKL(t&+te_ptext)
  62. WHILE PEEKB(t&)
  63.     a$=a$+CHR$(PEEKB(t&))
  64.     INCR t&
  65. WEND
  66. FNGette_ptext$=a$
  67. END DEF
  68.  
  69. DEF FNDialog (dial,edit)
  70. STATIC junk,tree&,x,y,w,h,but,type_tree,treeno,tree&
  71.  
  72. junk=FNrsrc_gaddr(0,dial,tree&)
  73. form_center tree&,x,y,w,h
  74. form_dial FMD_START,0,0,0,0,x,y,w,h
  75. form_dial FMD_GROW,x+w\2,y+h\2,0,0,x,y,w,h
  76. junk=FNobjc_draw(tree&,0,10,x,y,w,h)
  77. but=FNform_do(tree&,edit) AND &h7fff
  78. form_dial FMD_SHRINK,x+w\2,y+h\2,0,0,x,y,w,h
  79. form_dial FMD_FINISH,0,0,0,0,x,y,w,h
  80. Exclob_state but,mask_selected
  81.  
  82.  
  83. FNDialog=but
  84.  
  85. END DEF
  86.  
  87.  
  88. SUB ProcessUserMenus (title,item)
  89. STATIC dummy,finished,butn,txt$,a$
  90. SHARED finished
  91.  
  92. SELECT CASE item
  93.     CASE about:
  94.         dummy=FNdialog (info,0)
  95.     CASE view:
  96.         dummy=FNform_alert (1,"[1][ You clicked on 'View'! ][ OK ]")
  97.     CASE prin:
  98.         OPEN "MYTEXT.TXT" FOR INPUT AS #1
  99.         DO
  100.             LINE INPUT #1,a$
  101.             LPRINT a$
  102.         LOOP UNTIL EOF (1)
  103.         CLOSE #1
  104.     CASE opts:
  105.         dummy=FNform_alert (1,"[1][ You clicked on 'Printer | options'! ][ OK ]")
  106.     CASE reg:
  107.         butn=FNdialog (regist, regcode)
  108.         IF butn=regbut THEN
  109.             SelectTree regist
  110.             txt$=FNgette_ptext$ (regcode)
  111.             IF txt$="ReGiStEr" THEN
  112.                 junk=FNform_alert (1,"[1][ Key correct! ][ OK ]")
  113.             ELSE
  114.                 junk=FNform_alert (1,"[1][ Incorrect key! ][ OK ]")
  115.             END IF
  116.         END IF
  117.     CASE loads:
  118.         dummy=FNform_alert (1,"[1][ You clicked on 'Load | settings'! ][ OK ]")
  119.     CASE saves:
  120.         dummy=FNform_alert (1,"[1][ You clicked on 'Save | settings'! ][ OK ]")
  121.     CASE quit:
  122.         finished=-1
  123. END SELECT
  124. END SUB
  125.  
  126. SUB InitResourceFile(name$)
  127. STATIC junk
  128. SHARED resource_loaded
  129. IF FNrsrc_load(name$)=0 THEN
  130.     junk=FNform_alert(1,"[3][ Couldn't find PDO.RSC! ][ Quit ]")
  131.     SYSTEM
  132. END IF
  133. resource_loaded=-1
  134. END SUB
  135.  
  136. SUB StartProgram(resourcefile$,treenumber)
  137. SHARED WindX,WindY,WindW,WindH
  138. WINDOW ON
  139. InitResourceFile resourcefile$
  140. junk=FNwind_get(0,WF_WORKXYWH,WindX,WindY,WindW,WindH)
  141. InitMenuSystem treenumber
  142. END SUB
  143.  
  144. SUB StopProgram
  145. SHARED menu_pointer&
  146. STATIC junk
  147. IF menu_pointer& THEN menu_bar menu_pointer&,0
  148. junk=FNwind_set(0,WF_NEWDESK,0,0,0,0)
  149. junk=FNwind_update(END_UPDATE)
  150. junk=FNrsrc_free
  151.  
  152. STOP -1
  153. END SUB
  154.  
  155. SUB InitMenuSystem( treenumber)
  156. SHARED menu_pointer&,exit_item,menus_enabled
  157. junk=FNrsrc_gaddr(0,treenumber,menu_pointer&)
  158. menu_bar menu_pointer&,1
  159. menus_enabled=-1
  160. END SUB
  161.  
  162. SUB do_message(VAL mes_type)
  163. SHARED mess(1),menu_pointer&
  164. SHARED title,item
  165. STATIC title,item,junk
  166.  SELECT CASE mes_type
  167.  CASE MN_SELECTED:
  168.     title=mess(3)
  169.     item=mess(4)
  170.         CALL ProcessUserMenus (title,item)
  171.     menu_tnormal menu_pointer&,title,1
  172.  END SELECT
  173. END SUB
  174.  
  175. SUB do_keybd (VAL k)
  176. STATIC item,id
  177.  
  178. id=0
  179.  
  180. IF k=6144 THEN item=opts  : id=1 : REM Options
  181. IF k=9728 THEN item=loads : id=1 : REM Load options
  182. IF k=7936 THEN item=saves : id=1 : REM Save options
  183. IF k=12032 THEN item=view : id=1 : REM View file
  184. IF k=6400 THEN item=prin  : id=1 : REM print
  185. IF k=4096 THEN item=quit  : id=1 : REM quit!
  186. IF k=7680 THEN item=about : id=1 : REM about item
  187.  
  188. if id=1 then CALL ProcessUserMenus (0,item)
  189.  
  190. END SUB
  191.  
  192.  
  193.  
  194. DIM mess(16)
  195. StartProgram "PDO.RSC",menu
  196.  
  197. DO
  198.     e=FNevnt_multi(MU_MESAG+MU_KEYBD,0,0,0,0,0,0,0,0,0,0,0,0,0,_
  199.                     varptr(mess(0)),0,0,0,0,0,k,0)
  200.  
  201.     
  202.     IF e AND MU_MESAG THEN do_message mess(0)
  203.     IF e AND MU_KEYBD THEN do_keybd (k)
  204.  
  205. IF finished=-1 THEN CALL StopProgram
  206.  
  207. LOOP
  208.