home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / ac11disk / pdo / pdo.bas next >
BASIC Source File  |  1998-08-21  |  5KB  |  211 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(BYVAL t&)
  48. tree&=t&
  49. END SUB
  50.  
  51. SUB SelectTree(BYVAL treeno)
  52. STATIC formaddr&
  53.     junk=FNrsrc_gaddr(type_tree,treeno,formaddr&)
  54.     SelectTreeAddr formaddr&
  55. END SUB
  56.  
  57. DEF FNGette_ptext$(BYVAL 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,a$,code$,name$,pass$
  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.             code$=FNgette_ptext$ (regcode)
  111.             name$=FNgette_ptext$ (regname)
  112.  
  113.             pass$=LEFT$(name$,2)+RIGHT$(name$,3)+MID$(name$,3,3)
  114.             IF code$=pass$ THEN
  115.                 dummy=FNform_alert (1,"[1][ Correct key ][ OK ]")
  116.             ELSE
  117.                 dummy=FNform_alert (1,"[1][ Incorrect key ][ OK ]")
  118.             END IF
  119.         END IF
  120.     CASE loads:
  121.         dummy=FNform_alert (1,"[1][ You clicked on 'Load | settings'! ][ OK ]")
  122.     CASE saves:
  123.         dummy=FNform_alert (1,"[1][ You clicked on 'Save | settings'! ][ OK ]")
  124.     CASE quit:
  125.         finished=-1
  126. END SELECT
  127. END SUB
  128.  
  129. SUB InitResourceFile(name$)
  130. STATIC junk
  131. SHARED resource_loaded
  132. IF FNrsrc_load(name$)=0 THEN
  133.     junk=FNform_alert(1,"[3][ Couldn't find PDO.RSC! ][ Quit ]")
  134.     SYSTEM
  135. END IF
  136. resource_loaded=-1
  137. END SUB
  138.  
  139. SUB StartProgram(resourcefile$,treenumber)
  140. SHARED WindX,WindY,WindW,WindH
  141. WINDOW ON
  142. InitResourceFile resourcefile$
  143. junk=FNwind_get(0,WF_WORKXYWH,WindX,WindY,WindW,WindH)
  144. InitMenuSystem treenumber
  145. END SUB
  146.  
  147. SUB StopProgram
  148. SHARED menu_pointer&
  149. STATIC junk
  150. IF menu_pointer& THEN menu_bar menu_pointer&,0
  151. junk=FNwind_set(0,WF_NEWDESK,0,0,0,0)
  152. junk=FNwind_update(END_UPDATE)
  153. junk=FNrsrc_free
  154.  
  155. STOP -1
  156. END SUB
  157.  
  158. SUB InitMenuSystem( treenumber)
  159. SHARED menu_pointer&,exit_item,menus_enabled
  160. junk=FNrsrc_gaddr(0,treenumber,menu_pointer&)
  161. menu_bar menu_pointer&,1
  162. menus_enabled=-1
  163. END SUB
  164.  
  165. SUB do_message(VAL mes_type)
  166. SHARED mess(1),menu_pointer&
  167. SHARED title,item
  168. STATIC title,item,junk
  169.  SELECT CASE mes_type
  170.  CASE MN_SELECTED:
  171.     title=mess(3)
  172.     item=mess(4)
  173.         CALL ProcessUserMenus (title,item)
  174.     menu_tnormal menu_pointer&,title,1
  175.  END SELECT
  176. END SUB
  177.  
  178. SUB do_keybd (VAL k)
  179. STATIC item,id
  180.  
  181. id=0
  182.  
  183. IF k=6144 THEN item=opts  : id=1 : REM Options
  184. IF k=9728 THEN item=loads : id=1 : REM Load options
  185. IF k=7936 THEN item=saves : id=1 : REM Save options
  186. IF k=12032 THEN item=view : id=1 : REM View file
  187. IF k=6400 THEN item=prin  : id=1 : REM print
  188. IF k=4096 THEN item=quit  : id=1 : REM quit!
  189. IF k=7680 THEN item=about : id=1 : REM about item
  190.  
  191. if id=1 then CALL ProcessUserMenus (0,item)
  192.  
  193. END SUB
  194.  
  195.  
  196.  
  197. DIM mess(16)
  198. StartProgram "PDO.RSC",menu
  199.  
  200. DO
  201.     e=FNevnt_multi(MU_MESAG+MU_KEYBD,0,0,0,0,0,0,0,0,0,0,0,0,0,_
  202.                     varptr(mess(0)),0,0,0,0,0,k,0)
  203.  
  204.     
  205.     IF e AND MU_MESAG THEN do_message mess(0)
  206.     IF e AND MU_KEYBD THEN do_keybd (k)
  207.  
  208. IF finished=-1 THEN CALL StopProgram
  209.  
  210. LOOP
  211.