home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 604a.lha / TextraHyperText / TextraHyperText.rexx < prev   
Encoding:
OS/2 REXX Batch file  |  1992-01-21  |  6.0 KB  |  162 lines
  1. /**** Textra Rexx Command Link ****/
  2. /* Provides intuition interface for inserting HyperText commands */
  3. /* into a Textra document (must be Textra's current window) */
  4.  
  5. /* Written 22nd Dec 1991 by DAB - an English Import */
  6.  
  7.  
  8. if ~show('L','rexxsupport.library') then do
  9.     say 'Loading RexxSupport library'
  10.     check = addlib('rexxsupport.library',0,-30,0)
  11. end
  12. if ~show('L','rexxmathlib.library') then do
  13.     say 'Loading RexxMathLib library'
  14.     check = addlib('rexxmathlib.library',0,-30,0)
  15. end
  16. if ~show('L','rexxarplib.library') then do
  17.     say 'Loading RexxArpLib library'
  18.     check = addlib('rexxarplib.library',0,-30,0)
  19. end
  20.  
  21. if ~show('P','TEXTRA') then do
  22.     pmt = ' TEXTRA Port not found - have you started Textra ?'
  23.     yn = Request(50,50,pmt,,' ',' ')
  24.     exit
  25. end
  26.  
  27. call RexxWindow(DABHOST,DABPORT,240,49,380,150,"DAB's Textra/HyperText Interface")
  28.  
  29. /* AddGadget(Host,xpos,ypos,GadgetID,GadgetText,GadgetMessage) */
  30.  
  31. call AddGadget(DABHOST,20,15, "Font"      , "    Font    ", "Font")
  32. call AddGadget(DABHOST,20,30, "Title"     , "    Title   ", "Title")
  33. call AddGadget(DABHOST,20,45, "BGColor"   , "   BGColor  ", "BGColor")
  34. call AddGadget(DABHOST,20,60, "FGColor"   , "   FGColor  ", "FGColor")
  35. call AddGadget(DABHOST,20,75, "Location"  , "  Location  ", "Location")
  36. call AddGadget(DABHOST,20,90, "TextColor" , "  TextColor ", "TextColor")
  37. call AddGadget(DABHOST,20,105,"Help"      , "    Help    ", "Help")
  38.  
  39. call AddGadget(DABHOST,140,15, "EndLink"   , "   EndLink  ", "EndLink")
  40. call AddGadget(DABHOST,140,30, "Link"      , "    Link    ", "Link")
  41. call AddGadget(DABHOST,140,45, "Run"       , "    Run     ", "Run")
  42. call AddGadget(DABHOST,140,60, "Sound"     , "    Sound   ", "Sound")
  43. call AddGadget(DABHOST,140,75, "Show"      , "    Show    ", "Show")
  44. call AddGadget(DABHOST,140,90, "Anim"      , "    Anim    ", "Anim")
  45. call AddGadget(DABHOST,140,105,"Play"      , "    Play    ", "Play")
  46. call AddGadget(DABHOST,140,120,"ARexx"     , "    ARexx   ", "ARexx")
  47. call AddGadget(DABHOST,140,135,"Rexx"      , "    Rexx    ", "Rexx")
  48.  
  49. call AddGadget(DABHOST,260,15, "Bold"      , "    Bold    ", "Bold")
  50. call AddGadget(DABHOST,260,30, "Underline" , "  Underline ", "Underline")
  51. call AddGadget(DABHOST,260,45, "Italics"   , "   Italics  ", "Italics")
  52. call AddGadget(DABHOST,260,60, "Center"    , "   Center   ", "Center")
  53. call AddGadget(DABHOST,260,75, "Indent"    , "   Indent   ", "Indent")
  54. call AddGadget(DABHOST,260,90, "Format"    , "   Format   ", "Format")
  55. call AddGadget(DABHOST,260,105,"FreeFormat", " FreeFormat ", "FreeFormat")
  56.  
  57. start:
  58.  
  59.     quitflag = 0
  60.     do forever until quitflag    /* Until quitflag == 1 */
  61.         call WaitPkt(DABPORT) /* RexxSupport function - wait for a message */
  62.         p = GetPkt(DABPORT)   /* RexxSupport  - get message address pointer */
  63.  
  64.         if p ~== NULL() then do /* NULL = '0000 0000'x */
  65.  
  66.             argstring = getarg(p) /* RexxSupport Get Message String from */
  67.                                          /* default slot 0 */
  68.             t = reply(p,0)  /* RexxSupport - return message packet to sender */
  69.             thisarg = word(argstring,1) /* Rexx - get 1st word from string */
  70.             say argstring
  71.  
  72.             if thisarg == 'CLOSEWINDOW' then do
  73.                 call QuitProg(yn)
  74.                 if yn = 'OKAY' then do
  75.                     call CloseWindow(DABHOST,'')
  76.                     quitflag = 1
  77.                 end
  78.             end
  79.  
  80.             if thisarg == 'REFRESHWINDOW' then do
  81.                 call SetReqColor(DABHOST,BACKGROUNDPEN,1)
  82.                 call BackFill(DABHOST)                /**** Refresh Background */
  83.                 call RefreshGadgets(DABHOST)
  84.             end
  85.             
  86.  
  87.             if thisarg == 'Font' then address TEXTRA @TEXT "\font "
  88.             if thisarg == 'Title' then address TEXTRA @TEXT "\title "
  89.             if thisarg == 'BGColor' then address TEXTRA @TEXT "\bgcolor "
  90.             if thisarg == 'FGColor' then address TEXTRA @TEXT "\fgcolor "
  91.             if thisarg == 'Location' then address TEXTRA @TEXT "\location "
  92.             if thisarg == 'TextColor' then address TEXTRA @TEXT "\textcolor "
  93.             if thisarg == 'Help' then address TEXTRA @TEXT "\help "
  94.  
  95.             if thisarg == 'Link' then address TEXTRA @TEXT "\link {"
  96.             if thisarg == 'Run' then address TEXTRA @TEXT "\run {"
  97.             if thisarg == 'Sound' then address TEXTRA @TEXT "\sound {"
  98.             if thisarg == 'Show' then address TEXTRA @TEXT "\show {"
  99.             if thisarg == 'Anim' then address TEXTRA @TEXT "\anim {"
  100.             if thisarg == 'Play' then address TEXTRA @TEXT "\play {"
  101.             if thisarg == 'ARexx' then address TEXTRA @TEXT "\arexx {"
  102.             if thisarg == 'Rexx' then address TEXTRA @TEXT "\rexx {"
  103.             if thisarg == 'EndLink' then address TEXTRA @TEXT "\endlink "
  104.  
  105.             if thisarg == 'Bold' then address TEXTRA @TEXT "\bold "
  106.             if thisarg == 'Underline' then address TEXTRA @TEXT "\underline "
  107.             if thisarg == 'Italics' then address TEXTRA @TEXT "\italics "
  108.             if thisarg == 'Center' then address TEXTRA @TEXT "\center "
  109.             if thisarg == 'Indent' then address TEXTRA @TEXT "\indent "
  110.             if thisarg == 'Format' then address TEXTRA @TEXT "\format "
  111.             if thisarg == 'FreeFormat' then address TEXTRA @TEXT "\freeformat "
  112.  
  113.         end    /** if **/
  114.     
  115.     end    /** do **/
  116.  
  117. exit
  118.  
  119.  
  120. QuitProg:
  121. arg yn
  122.     pmt = ' Are You Sure you want to Quit?'
  123.     yn = Request(50,50,pmt,,'OK','Cancel')
  124.     say yn
  125. return yn
  126.  
  127.  
  128. /* RexxWindow.rexx */
  129.  
  130. RexxWindow:
  131. arg menuhost, menuport, xpos, ypos, wd, ht, titletxt
  132.  
  133.     parse version 'V' vers .
  134.     if vers > 1.06
  135.        then address AREXX  "'x=createhost("menuhost ","menuport")'"
  136.    else "runwsh >nil:" "'x=createhost("menuhost","menuport ")'"
  137.  
  138.     mp = openport(menuport)
  139.     
  140.     do for 10/(10/50) while ~showlist('p',menuhost)
  141.        call delay 10
  142.     end
  143.  
  144.     if ~(mp & showlist('p',menuhost)) then return
  145.  
  146.     idcmp = 'CLOSEWINDOW+GADGETUP+REFRESHWINDOW'
  147.   flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+BACKFILL+ACTIVATE'
  148.  
  149.    call SetReqColor(menuhost,OKAYPEN,2)            /**** Gadget Text */
  150.     call SetReqColor(menuhost,BACKGROUNDPEN,1)    /**** Gadget Background */
  151.    call SetReqColor(menuhost,SHADOWPEN,2)            /**** Gadget Shadow */
  152.    call SetReqColor(menuhost,BLOCKPEN,1)            /**** WindowDragBar etc. */
  153.    call SetReqColor(menuhost,BOXPEN,0)                /**** Gadget 'frame' */
  154.  
  155.    /* Open the window - top left edge at xpos,ypos */
  156.    call OpenWindow(menuhost,xpos,ypos,wd,ht,idcmp,flags,titletxt)
  157.    call SetAPen(menuhost,1)
  158.    call SetBPen(menuhost,1)
  159.    call SetDrMd(menuhost,JAM2)
  160.  
  161. return 0    /**** RexxWindow */
  162.