home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / ac14disk / hbasic / pdo.bas next >
Encoding:
BASIC Source File  |  1999-04-10  |  6.1 KB  |  286 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. SUB InitFileSelector
  88. SHARED fspath$,fsname$
  89. fspath$=CURDIR$+"\*.*"
  90. fsname$=""
  91. END SUB
  92.  
  93. FUNCTION aes_version
  94. aes_version=PEEKW(PEEKL(GB+4))
  95. END FUNCTION
  96.  
  97. FUNCTION fileselector$ (fsmessage$)
  98. SHARED fspath$,fsname$
  99. STATIC ok,i,ch
  100.  
  101. IF fspath$="" THEN CALL InitFileSelector
  102. IF aes_version<&H130 THEN
  103.     fsel_input fspath$,fsname$,ok
  104. ELSE 
  105.     fsel_exinput fspath$,fsname$,ok,fsmessage$
  106. END IF
  107.  
  108. IF ok THEN
  109.     i=LEN(fspath$)
  110.     DO
  111.         ch=ASC(MID$(fspath$,i,1))
  112.         IF ch="\"% OR ch=":"% THEN EXIT LOOP
  113.         IF i=1 THEN EXIT LOOP
  114.         DECR i
  115.     LOOP 
  116.     FileSelector$=LEFT$(fspath$,i)+fsname$
  117. ELSE
  118.     fileselector$=""
  119. END IF
  120.  
  121. END FUNCTION
  122.  
  123. SUB ProcessUserMenus (title,item)
  124. STATIC dummy,finished,butn,a$,code$,name$,pass$,prinfile$
  125. STATIC temp_1$,viewfile$,file$
  126. SHARED finished,global_viewer$,commandline
  127.  
  128. SELECT CASE item
  129.     CASE about:
  130.         dummy=FNdialog (info,0)
  131.     CASE view:
  132.         viewfile$=fileselector$("Please select file to print")
  133.         IF viewfile$<>"" THEN
  134. '             Execute global_viewer$,viewfile$
  135.         END IF
  136.     CASE prin:
  137.         IF commandline=0 THEN
  138.             prinfile$=fileselector$("Please select file to print")
  139.         END IF
  140.         
  141.         IF prinfile$<>"" THEN
  142.             OPEN prinfile$ FOR INPUT AS #1
  143.                 DO
  144.                     LINE INPUT #1,a$
  145.                     LPRINT a$
  146.                 LOOP UNTIL EOF (1)
  147.             CLOSE #1
  148.         END IF
  149.         
  150.         IF commandline=1 THEN
  151.             finished=-1
  152.         END IF
  153.         
  154.     CASE progopts:
  155.         SelectTree progoptsform
  156.         temp_1$=FNGette_ptext$ (fileviewer)
  157.         DO
  158.             butn=FNdialog (progoptsform,0)
  159.             SELECT CASE butn
  160.                 CASE poptscancel
  161.                     sette_ptext fileviewer,temp_1$
  162.                 CASE viewbut
  163.                     file$=fileselector$("Select viewing program")
  164.                     IF file$<>"" THEN
  165.                         sette_ptext fileviewer,file$
  166.                     END IF
  167.             END SELECT
  168.         LOOP UNTIL (butn=poptsok) OR (butn=poptscancel)
  169.         global_viewer$=FNgette_ptext$ (fileviewer)
  170.     CASE opts:
  171.         dummy=FNform_alert (1,"[1][ You clicked on 'Printer | options'! ][ OK ]")
  172.     CASE reg:
  173.         butn=FNdialog (regist, regcode)
  174.         IF butn=regbut THEN
  175.             SelectTree regist
  176.             code$=FNgette_ptext$ (regcode)
  177.             name$=FNgette_ptext$ (regname)
  178.  
  179.             pass$=LEFT$(name$,2)+RIGHT$(name$,3)+MID$(name$,3,3)
  180.             IF code$=pass$ THEN
  181.                 dummy=FNform_alert (1,"[1][ Correct key ][ OK ]")
  182.             ELSE
  183.                 dummy=FNform_alert (1,"[1][ Incorrect key ][ OK ]")
  184.             END IF
  185.         END IF
  186.     CASE loads:
  187.         dummy=FNform_alert (1,"[1][ You clicked on 'Load | settings'! ][ OK ]")
  188.     CASE saves:
  189.         dummy=FNform_alert (1,"[1][ You clicked on 'Save | settings'! ][ OK ]")
  190.     CASE quit:
  191.         finished=-1
  192. END SELECT
  193. END SUB
  194.  
  195. SUB InitResourceFile(name$)
  196. STATIC junk
  197. SHARED resource_loaded
  198. IF FNrsrc_load(name$)=0 THEN
  199.     junk=FNform_alert(1,"[3][ Couldn't find PDO.RSC! ][ Quit ]")
  200.     SYSTEM
  201. END IF
  202. resource_loaded=-1
  203. END SUB
  204.  
  205. SUB StartProgram(resourcefile$,treenumber)
  206. SHARED WindX,WindY,WindW,WindH
  207. WINDOW ON
  208. InitResourceFile resourcefile$
  209. junk=FNwind_get(0,WF_WORKXYWH,WindX,WindY,WindW,WindH)
  210. InitMenuSystem treenumber
  211. END SUB
  212.  
  213. SUB StopProgram
  214. SHARED menu_pointer&
  215. STATIC junk
  216. IF menu_pointer& THEN menu_bar menu_pointer&,0
  217. junk=FNwind_set(0,WF_NEWDESK,0,0,0,0)
  218. junk=FNwind_update(END_UPDATE)
  219. junk=FNrsrc_free
  220.  
  221. STOP -1
  222. END SUB
  223.  
  224. SUB InitMenuSystem( treenumber)
  225. SHARED menu_pointer&,exit_item,menus_enabled
  226. junk=FNrsrc_gaddr(0,treenumber,menu_pointer&)
  227. menu_bar menu_pointer&,1
  228. menus_enabled=-1
  229. END SUB
  230.  
  231. SUB do_message(VAL mes_type)
  232. SHARED mess(1),menu_pointer&
  233. SHARED title,item
  234. STATIC title,item,junk
  235.  SELECT CASE mes_type
  236.  CASE MN_SELECTED:
  237.     title=mess(3)
  238.     item=mess(4)
  239.         CALL ProcessUserMenus (title,item)
  240.     menu_tnormal menu_pointer&,title,1
  241.  END SELECT
  242. END SUB
  243.  
  244. SUB do_keybd (VAL k)
  245. STATIC item,id
  246.  
  247. id=0
  248. IF k=6144 THEN item=opts  : id=1 : REM Options
  249. IF k=9728 THEN item=loads : id=1 : REM Load options
  250. IF k=7936 THEN item=saves : id=1 : REM Save options
  251. IF k=12032 THEN item=view : id=1 : REM View file
  252. IF k=6400 THEN item=prin  : id=1 : REM print
  253. IF k=4096 THEN item=quit  : id=1 : REM quit!
  254. IF k=7680 THEN item=about : id=1 : REM about item
  255. IF k=8704 THEN item=progopts : id=1 : REM Program Options
  256.  
  257. if id=1 then CALL ProcessUserMenus (0,item)
  258.  
  259. END SUB
  260.  
  261.  
  262.  
  263. DIM mess(16)
  264. StartProgram "PDO.RSC",menu
  265. SelectTree progoptsform
  266. Sette_ptext fileviewer,""
  267. global_viewer$=""
  268.  
  269. prinfile$=COMMAND$
  270. IF prinfile$<>"" THEN
  271.     commandline=1
  272.     CALL ProcessUserMenus (0,prin)
  273. END IF
  274.  
  275. DO
  276.     e=FNevnt_multi(MU_MESAG+MU_KEYBD,0,0,0,0,0,0,0,0,0,0,0,0,0,_
  277.                     varptr(mess(0)),0,0,0,0,0,k,0)
  278.  
  279.     
  280.     IF e AND MU_MESAG THEN do_message mess(0)
  281.     IF e AND MU_KEYBD THEN do_keybd (k)
  282.  
  283. IF finished=-1 THEN CALL StopProgram
  284.  
  285. LOOP
  286.