home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / hbasic_1 / source / www_code.bas < prev    next >
Encoding:
BASIC Source File  |  1996-11-09  |  8.5 KB  |  394 lines
  1. '$option k100y
  2. DEFINT a-z
  3. '$include xgemaes.bh
  4. '$include gemaes.bh
  5. '$include xbios.bh
  6.  
  7. LIBRARY "gemaes","gemdos","speedo","falcon","gemvdi","xbios"
  8. WINDOW OFF
  9. CALL vsf_color(8)
  10. path$="C:\*.htm"
  11. file$=""
  12. button=0
  13. primpt$="Select HTML to load..."
  14. CALL fsel_exinput(path$,file$,button,prompt$)
  15. path$=LEFT$(path$,LEN(path$)-5)
  16. IF file$="" THEN SYSTEM
  17. OPEN path$+file$ FOR INPUT AS #1
  18. l&=LOF(1)
  19. m&=mxalloc&(l&,0)
  20. IF m&=0 THEN CLOSE #1:STOP
  21. BLOAD #1,m&,l&
  22. CLOSE #1
  23. dum=wind_get(desk,wf_workxywh,x,y,w,h)
  24. handle=wind_create(w_name+w_closer+w_mover+w_smaller+w_sizer+w_vslide,x,y,w,h)
  25. dum=rsrc_gaddr(r_tree,tools_form,tools_addr&)
  26. dum=wind_calc(wc_border,w_name+w_closer+w_mover+w_smaller+w_sizer+w_vslide,100,100,500,300,x,y,w,h)
  27. title$="WWW HTML reader"+CHR$(0)
  28. title&=SADD(title$)
  29. dum=wind_set(handle,wf_name,PEEKW(VARPTR(title&)),PEEKW(VARPTR(title&)+2),0,0)
  30. dum=wind_open(handle,x,y,w,h)
  31. buffer&=mxalloc&(16,0)
  32. IF buffer&=0 THEN STOP
  33. dum=vst_load_fonts
  34. CALL vst_font(vqt_name(25,name$))
  35. font=12
  36. dum=vst_arbpt(12,0,chrh,0,0)
  37. DO
  38. message=evnt_multi(mu_mesag,0,0,0,0,0,0,0,0,0,0,0,0,0,buffer&,0,0,0,0,0,0,0)
  39. IF (message AND mu_mesag)=mu_mesag THEN CALL message_received
  40. LOOP
  41. STOP
  42.  
  43.  
  44. SUB redraw
  45. SHARED buffer&
  46. LOCAL x,y,w,h,dum         
  47. dum=wind_update(beg_update)
  48. CALL graf_mouse(m_off,0)
  49. dum=wind_get(PEEKW(buffer&+6),wf_firstxywh,x,y,w,h)
  50. WHILE w>0 AND h>0
  51. CALL vs_clip(1,x,y,x+w-1,y+h-1)
  52. CALL text_print
  53. CALL vs_clip(0,0,0,0,0)
  54. dum=wind_get(PEEKW(buffer&+6),wf_nextxywh,x,y,w,h)
  55. WEND
  56. CALL graf_mouse(m_on,0)
  57. dum=wind_update(end_update)
  58. END SUB
  59.  
  60.  
  61. SUB text_print
  62. SHARED handle,m&,chrh,font,l&
  63. LOCAL x,y,w,h,dum,ty,tx,mpos&,alignx,cmd$,title&
  64. LOCAL advx,i,bit$,line$,letter$,size,np,title$,name$,test$
  65. LOCAL count,tally$,corr,b_n,oldfont,oldsize,valign
  66. CALL vswr_mode(2)
  67. dum=wind_get(handle,wf_workxywh,x,y,w,h)
  68. CALL v_bar(x,y,x+w-1,y+h-1)
  69. ty=y+10
  70. tx=x-25
  71. size=12
  72. font=12
  73. tally$=""
  74. corr=0
  75. effects=0
  76. mpos&=m&
  77. line$=""
  78. tally=0
  79. WHILE ty+chrh=<y+h+12 AND mpos&<m&+l&
  80.     letter$=CHR$(PEEKB(mpos&))
  81.     INCR mpos&
  82.     CALL vqt_advance(ASC(letter$),advx,0,0,0)
  83.     INCR advx
  84.     SELECT CASE letter$
  85.         CASE CHR$(10)
  86.             letter$=""
  87.             CALL vqt_advance(32,advx,0,0,0)
  88.         CASE CHR$(13)
  89.             letter$=""
  90.             CALL vqt_advance(32,advx,0,0,0)
  91.         CASE "<"
  92.             cmd$="<"
  93.             WHILE RIGHT$(cmd$,1)<>">"
  94.                 cmd$=cmd$+CHR$(PEEKB(mpos&))
  95.                 INCR mpos&
  96.             WEND
  97.             bit$=CHR$(PEEKB(mpos&))
  98.             IF bit$=CHR$(32) THEN
  99.                 line$=line$+CHR$(32)
  100.                 CALL vqt_advance(32,advx,0,0,0)
  101.                 alignx=alignx+advx
  102.                 INCR mpos&
  103.             END IF
  104.             cmd$=UCASE$(cmd$)
  105.             SELECT CASE cmd$
  106.             CASE "<SUB>"
  107.                 oldsize=size
  108.                 size=size/2
  109.                 valign=2
  110.             CASE "</SUB>"
  111.                 size=oldsize
  112.                 valign=-2
  113.             CASE "<SUP>"
  114.                 oldsize=size
  115.                 size=size/2
  116.                 valign=1
  117.             CASE "</SUP>"
  118.                 size=oldsize
  119.                 valign=-1
  120.             CASE "<HR>"
  121.                 CALL vsf_color(9)
  122.                 CALL v_bar(x+10,ty,x+w-11,ty+1)
  123.                 CALL vsf_color(0)
  124.                 CALL v_bar(x+11,ty+1,x+w-11,ty+1)
  125.                 CALL v_bar(x+w-11,ty,x+w-11,ty)
  126.                 CALL vsf_color(8)
  127.                 np=1
  128.             CASE "<UL>"
  129.                 x=x+40
  130.             CASE "</UL>"
  131.                 x=x-40
  132.                 np=1
  133.             CASE "<LI>"
  134.                 np=1
  135.                 b_n=1
  136.             CASE "<H1>"
  137.                 oldfont=font
  138.                 oldsize=size
  139.                 font=14
  140.                 size=25
  141.                 np=1
  142.             CASE "</H1>"
  143.                 font=oldfont
  144.                 size=oldsize
  145.                 np=1
  146.             CASE "<H2>"
  147.                 oldsize=size
  148.                 oldfont=font
  149.                 font=14
  150.                 size=18
  151.                 np=1
  152.             CASE "</H2>"
  153.                 font=oldfont
  154.                 size=oldsize
  155.                 np=1
  156.             CASE "<H3>"
  157.                 oldfont=font
  158.                 oldsize=size
  159.                 font=13
  160.                 size=15
  161.                 np=1
  162.             CASE "</H3>"
  163.                 size=oldsize
  164.                 font=oldfont
  165.                 np=1
  166.             CASE "<H4>"
  167.                 oldfont=font
  168.                 font=14
  169.                 x=x+10
  170.                 np=1
  171.             CASE "</H4>"
  172.                 font=oldfont
  173.                 x=x-10
  174.                 np=1
  175.             CASE "<H5>"
  176.                 oldfont=font
  177.                 oldsize=size
  178.                 font=13
  179.                 size=10
  180.                 x=x+10
  181.                 np=1  
  182.             CASE "</H5>"
  183.                 font=oldfont
  184.                 size=oldsize
  185.                 x=x-10
  186.                 np=1
  187.             CASE "<H6>"
  188.                 oldfont=font
  189.                 oldsize=size
  190.                 x=x+15
  191.                 font=14
  192.                 size=7
  193.                 np=1
  194.             CASE "</H6>"
  195.                 font=oldfont
  196.                 size=oldsize
  197.                 x=x-15
  198.                 np=1
  199.             CASE "<B>"
  200.                 IF font=12 THEN font=14
  201.                 IF font=13 THEN font=15
  202.             CASE "</B>"
  203.                 IF font=15 THEN font=13
  204.                 IF font=14 THEN font=12
  205.             CASE "<I>"
  206.                 IF font=14 THEN font=15
  207.                 IF font=12 THEN font=13
  208.             CASE "</I>"
  209.                 IF font=13 THEN font=12
  210.                 IF font=15 THEN font=14
  211.             CASE "<U>"
  212.                 effects=8
  213.             CASE "</U>"
  214.                 effects=0
  215.             CASE "<P>"
  216.                 np=1
  217.             CASE "<TITLE>"
  218.                 bit$=""
  219.                 WHILE bit$<>">"
  220.                     bit$=CHR$(PEEKB(mpos&))
  221.                     INCR mpos&
  222.                     title$=title$+bit$
  223.                 WEND
  224.                 title$=LEFT$(title$,LEN(title$)-8)+CHR$(0)
  225.                 title&=SADD(title$)
  226.                 dum=wind_set(handle,wf_name,PEEKW(VARPTR(title&)),PEEKW(VARPTR(title&)+2),0,0)
  227.             CASE "<CENTER>"
  228.                 count=0
  229.                 tally$=""
  230.                 corr=0
  231.                 DO
  232.                     INCR count
  233.                     bit$=CHR$(PEEKB(mpos&+count))
  234.                     IF bit$="<" THEN
  235.                         test$="<"
  236.                         WHILE RIGHT$(test$,1)<>">"
  237.                             INCR count
  238.                             test$=test$+CHR$(PEEKB(mpos&+count))
  239.                         WEND
  240.                         bit$=""
  241.                     END IF
  242.                     IF UCASE$(test$)="</CENTER>" THEN EXIT LOOP
  243.                     tally$=tally$+bit$
  244.                 LOOP
  245.                 FOR count=1 TO LEN(tally$)
  246.                     CALL vqt_advance(ASC(RIGHT$(LEFT$(tally$,count),1)),advx,0,0,0)
  247.                     corr=corr+advx
  248.                 NEXT count
  249.             CASE "</CENTER>"
  250.                 np=1
  251.             
  252.             CASE "<RIGHT>"
  253.                 count=0
  254.                 tally$=""
  255.                 corr=0
  256.                 DO
  257.                     INCR count
  258.                     bit$=CHR$(PEEKB(mpos&+count))    
  259.                     IF bit$="<" THEN
  260.                     test$="<"
  261.                         WHILE RIGHT$(test$,1)<>">"
  262.                             INCR count
  263.                             test$=test$+CHR$(PEEKB(mpos&+count))
  264.                         WEND
  265.                     END IF
  266.                     IF UCASE$(test$)="</RIGHT>" THEN EXIT LOOP
  267.                     tally$=tally$+bit$
  268.                 LOOP
  269.                 FOR count=1 TO LEN(tally$)
  270.                     CALL vqt_advance(ASC(RIGHT$(LEFT$(tally$,count),1)),advx,0,0,0)
  271.                     corr=corr+advx+4
  272.                 NEXT count
  273.                 corr=-corr
  274.             CASE "</RIGHT>"
  275.                 np=1
  276.                 
  277.             END SELECT
  278.             IF tx+alignx=<w+x-1 THEN
  279.                 CALL v_ftext(tx,ty,line$)
  280.                 line$=""
  281.                 tx=tx+alignx
  282.                 alignx=0
  283.             ELSE
  284.                 ty=ty+chrh
  285.                 tx=x+3
  286.                 CALL v_ftext(tx,ty,line$)
  287.                 tx=tx+alignx
  288.                 alignx=0
  289.                 line$=""
  290.             END IF
  291.             letter$=""
  292.             advx=0
  293.             IF corr<>0 THEN
  294.                 SELECT CASE corr
  295.                     CASE >0
  296.                         tx=((x+w-1)/2)-(corr/2)
  297.                     CASE <0
  298.                         tx=(x+w-1)+corr
  299.                 END SELECT
  300.                 corr=0
  301.             END IF
  302.             IF valign>0 THEN
  303.                 IF valign=1 THEN ty=ty-(chrh/2) ELSE ty=ty+(chrh/6)
  304.                 valign=0 
  305.             END IF
  306.             CALL vst_font(vqt_name(font,name$))
  307.             dum=vst_arbpt(size,0,chrh,0,0)
  308.             CALL vst_effects(effects)
  309.             IF np>0 THEN
  310.                 ty=ty+chrh
  311.                 tx=x+3
  312.                 np=0
  313.             END IF
  314.             IF valign<0 THEN
  315.                 IF valign=-1 THEN ty=ty+(chrh/2) ELSE ty=ty-(chrh/6)
  316.                 valign=0
  317.             END IF
  318.             IF b_n>0 THEN
  319.                 CALL v_ftext(x-20,ty,CHR$(249))
  320.                 b_n=0
  321.             END IF
  322.         CASE CHR$(32)
  323.             line$=line$+CHR$(32)
  324.             alignx=alignx+advx
  325.             advx=0
  326.             IF tx+alignx=<w+x-1 THEN
  327.                 CALL v_ftext(tx,ty,line$)
  328.                 line$=""
  329.                 tx=tx+alignx
  330.                 alignx=0
  331.             ELSE
  332.                 ty=ty+chrh
  333.                 tx=x+3
  334.                 CALL v_ftext(tx,ty,line$)
  335.                 tx=tx+alignx
  336.                 alignx=0
  337.                 line$=""
  338.             END IF
  339.             letter$=""
  340.     END SELECT
  341.     alignx=alignx+advx
  342.     line$=line$+letter$
  343. WEND    
  344. END SUB
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351. SUB message_received
  352. SHARED buffer&,menu_add&
  353. STATIC type,title$,title&,dum1,cur_pos,w,h
  354. type=PEEKW(buffer&)
  355. SELECT CASE type
  356.     CASE mn_selected
  357.         CALL menu_tnormal(menu_add&,3,1)
  358.     CASE wm_redraw
  359.         CALL redraw
  360.     CASE wm_topped
  361.         dum=wind_set(PEEKW(buffer&+6),wf_top,PEEKW(buffer&+6),0,0,0)
  362.     CASE wm_closed
  363.         dum=mfree(buffer&)
  364.         SYSTEM
  365.     CASE wm_vslid
  366.         dum=wind_set(PEEKW(buffer&+6),wf_vslide,PEEKW(buffer&+8),0,0,0)
  367.     CASE wm_sized
  368.         dum=wind_get(PEEKW(buffer&+6),wf_currxywh,0,0,w,h)
  369.         dum=wind_set(PEEKW(buffer&+6),wf_currxywh,PEEKW(buffer&+8),PEEKW(buffer&+10),PEEKW(buffer&+12),PEEKW(buffer&+14))
  370.         IF PEEKW(buffer&+12)<w OR PEEKW(buffer&+14)<h THEN CALL redraw
  371.     CASE wm_moved
  372.         dum=wind_set(PEEKW(buffer&+6),wf_currxywh,PEEKW(buffer&+8),PEEKW(buffer&+10),PEEKW(buffer&+12),PEEKW(buffer&+14))
  373.     CASE wm_untopped
  374.     
  375.     CASE wm_ontop
  376.     
  377.     CASE wm_bottom
  378.         dum=wind_set(PEEKW(buffer&+6),wf_bottom,PEEKW(buffer&+6),0,0,0)
  379.     CASE wm_iconify
  380.         dum=wind_set(PEEKW(buffer&+6),wf_iconify,PEEKW(buffer&+8),PEEKW(buffer&+10),PEEKW(buffer&+12),PEEKW(buffer&+14))
  381.         title$="WWW"+CHR$(0)
  382.         title&=SADD(title$)
  383.         dum=wind_set(PEEKW(buffer&+6),wf_name,PEEKW(VARPTR(title&)),PEEKW(VARPTR(title&)+2),0,0)
  384.     CASE wm_uniconify
  385.         dum=wind_set(PEEKW(buffer&+6),wf_uniconify,PEEKW(buffer&+8),PEEKW(buffer&+10),PEEKW(buffer&+12),PEEKW(buffer&+14))
  386.         title$="WWW HTML Reader"+CHR$(0)
  387.         title&=SADD(title$)
  388.         dum=wind_set(PEEKW(buffer&+6),wf_name,PEEKW(VARPTR(title&)),PEEKW(VARPTR(title&)+2),0,0)
  389.     CASE ap_term
  390.         CALL pterm0
  391.     CASE ap_dragdrop
  392.     
  393. END SELECT
  394. END SUB