home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / WordProcessors / UNT-AXFW.LHA / fwmacros / FinalWrapper.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-06-15  |  27.6 KB  |  990 lines
  1. /* $VER: FinalWrapper 2.1 (11.06.94) by NDY's */
  2.  
  3. /* Main [2.1] */
  4. OPTIONS RESULTS
  5. SIGNAL ON ERROR
  6. SIGNAL ON SYNTAX
  7. initerr=init()
  8. ADDRESS VALUE rxport
  9. CALL locale
  10. DO WHILE closed=2
  11.   IF guiinit()=5 THEN
  12.     DO
  13.       ShowMessage 1 1 nogui
  14.       CALL bye(50)
  15.     END
  16.   CALL gui
  17.   IF closed~=2 THEN CALL guiclean
  18.   CALL options
  19.   IF chosenobjs()=0 THEN
  20.     DO
  21.       CALL pointnoval
  22.       IF txt>0 THEN
  23.         CALL textblock
  24.       ELSE
  25.         CALL bodytext
  26.       IF ~broken THEN CALL initwrap
  27.       IF ~broken THEN CALL wrap
  28.       IF ~broken THEN CALL group
  29.       rescan=Max(rescan-1,0)
  30.       broken=0
  31.     END
  32. END
  33. CALL bye(0)
  34.  
  35. PROC init: /* Initialization [2.1] */
  36.   /* Vars needed by "bye" / "ERROR" */
  37.   errtext='"%t" "(#%n) in line %l" "" "Ok" "" ""'
  38.   objs=0
  39.   deci=""
  40.   et=""
  41.   lib.1=0
  42.   lib.2=0
  43.   lib.3=0
  44.   cleangui=0
  45.   /* Started by Final Writer? */
  46.   rxport=ADDRESS()
  47.   portok=Left(rxport,7)="FINALW."
  48.   IF ~portok THEN
  49.     DO i=1 TO 10 UNTIL portok
  50.       rxport="FINALW."||i
  51.       portok=Show("p",rxport)
  52.     END
  53.   IF ~portok THEN RETURN 13
  54.   /* Open libraries */
  55.   library.1="rexxmathlib.library"
  56.   library.2="rexxsupport.library"
  57.   library.3="apig.library"
  58.   DO libn=1 TO 3
  59.     lib.libn=Show("l",library.libn)
  60.     IF ~lib.libn THEN lib.libn=AddLib(library.libn,0,-30,0)
  61.     IF ~lib.libn THEN RETURN 14
  62.   END
  63.   libn=3
  64.   /* Load defaults */
  65.   preff.1="ENV:FinalWrapper.def"
  66.   preff.2="ENVARC:FinalWrapper.def"
  67.   DO i=1 TO 2 UNTIL ok
  68.     ok=Open(prefs,preff.i,"R")
  69.     IF ok THEN
  70.       DO
  71.         default=ReadCh(prefs,52)
  72.         CALL Close(prefs)
  73.       END
  74.   END
  75.   port=0
  76.   rescan=1
  77.   broken=0
  78.   closed=2
  79.   oldlen=0
  80.   oldtxt=0
  81.   oldoval=0
  82.   oldobjs=0
  83. RETURN 0
  84. PROC locale: /* Language specific strings [2.1] */
  85.   lang=getlanguage()
  86.   test=0  /* test 1/2/3/4/6/7/8/10/20/100/200 WITH new languages, 0 = no test */
  87.   IF lang="deutsch" THEN /* German */
  88.     DO
  89.       wintitle="%i"
  90.       ltxt.1.1="Sektor (°): Im Uhrzeigersinn"
  91.       ltxt.1.2="Sektor (°): Im Gegenuhrzeigersinn"
  92.       ltxt.2.1="Spirale (%): Von innen nach aussen"
  93.       ltxt.2.2="Spirale (%): Von aussen nach innen"
  94.       ltxt.3.1="Größe (%): Grösser werdend"
  95.       ltxt.3.2="Größe (%): Kleiner werdend"
  96.       ltxt.4.1="Start (°): Im Uhrzeigersinn"
  97.       ltxt.4.2="Start (°): Im Gegenuhrzeigersinn"
  98.       ltxt.4.3="Start (°): Absolut"
  99.       ltxt.5.1="Rotation (°): Uhrzeigersinn"
  100.       ltxt.5.2="Rotation (°): Gegenuhrzeigersinn"
  101.       ltxt.5.3="Rotation (°): Absolut"
  102.       ltxt.5.4="Rotation: Wie Textblock"
  103.       ltxt.6.1="Löschen: Oval und Textblock"
  104.       ltxt.6.2="Löschen: Nichts"
  105.       ltxt.6.3="Löschen: Oval kopieren"
  106.       ltxt.6.4="Löschen: Nur Oval"
  107.       ltxt.7.1="Gruppieren: Ausgewähltes Oval"
  108.       ltxt.7.2="Gruppieren: Unsichtbares Oval"
  109.       ltxt.7.3="Gruppieren: Nein"
  110.       ltxt.8.1="Anpassen: Zeichengrösse"
  111.       ltxt.8.2="Anpassen: Zeichenbreite"
  112.       ltxt.8.3="Anpassen: Sektorgrösse"
  113.       ltxt.8.4="Anpassen: Nichts"
  114.       ltxt.9="Screen anzeigen"
  115.       ltxt.10="Gadgets aktivieren"
  116.       ltxt.11="Einstellungen behalten"
  117.       ltxt.12="Neuer Text"
  118.       ltxt.13="Standard setzen"
  119.       ltxt.14="  Ok  "
  120.       ltxt.15="Zeichnen"
  121.       ltxt.16="Abbruch"
  122.       errtext='"FinalWrapper-Fehler:" "%t" "in Zeile %l (Fehlernummer %n)" "Ok" "" ""'
  123.       noselect='"FinalWrapper-Fehler:" "Zuerst einen Textblock oder einen" "Textausschnitt und ein Oval wählen!" "Ok" "" ""'
  124.       fwerrtext.10='Befehl gescheitert'
  125.       fwerrtext.20='Ungültige Argumente'
  126.       fwerrtext.100='Befehl unbekannt'
  127.       fwerrtext.200='Kann fwarexx.library nicht öffnen'
  128.       nolib='"FinalWrapper-Fehler:" "Konnte ''%y'' nicht öffnen!" "" "Ok" "" ""'
  129.       nofw='FinalWrapper-Fehler: Final Writer nicht gefunden!'
  130.       wrongos='"FinalWrapper-Fehler:" "Es wird mindestens OS2.0" "benötigt!" "Ok" "" ""'
  131.       stillalive='"FinalWrapper läuft bereits!" "" "" "Ok" "" ""'
  132.       nogui='"FinalWrapper-Fehler:" "Konnte Requester nicht öffnen!" "" "Ok" "" ""'
  133.     END
  134.   ELSE /* Default: English */
  135.     DO
  136.       wintitle="%i"
  137.       ltxt.1.1="Arc (°): Write clockwise"
  138.       ltxt.1.2="Arc (°): Write anticlockwise"
  139.       ltxt.2.1="Spiral (%): Inside to outside"
  140.       ltxt.2.2="Spiral (%): Outside to inside"
  141.       ltxt.3.1="Size (%): Increasing"
  142.       ltxt.3.2="Size (%): Decreasing"
  143.       ltxt.4.1="Start (°): Shift clockwise"
  144.       ltxt.4.2="Start (°): Shift anticlockwise"
  145.       ltxt.4.3="Start (°): Absolute"
  146.       ltxt.5.1="Rotate (°): Clockwise"
  147.       ltxt.5.2="Rotate (°): Anticlockwise"
  148.       ltxt.5.3="Rotate (°): Absolute"
  149.       ltxt.5.4="Rotate: Like textblock"
  150.       ltxt.6.1="Delete: Oval and textblock"
  151.       ltxt.6.2="Delete: Nothing"
  152.       ltxt.6.3="Delete: Copy oval"
  153.       ltxt.6.4="Delete: Oval only"
  154.       ltxt.7.1="Group: Selected oval"
  155.       ltxt.7.2="Group: Invisible oval"
  156.       ltxt.7.3="Group: No"
  157.       ltxt.8.1="Adjust: Character size"
  158.       ltxt.8.2="Adjust: Character width"
  159.       ltxt.8.3="Adjust: Arc"
  160.       ltxt.8.4="Adjust: Nothing"
  161.       ltxt.9="Autoshow Screen "
  162.       ltxt.10="Autoactivate gadgets"
  163.       ltxt.11="Preserve settings"
  164.       ltxt.12="Rescan"
  165.       ltxt.13="Set default"
  166.       ltxt.14="  Ok  "
  167.       ltxt.15=" Draw "
  168.       ltxt.16="Cancel"
  169.       errtext='"FinalWrapper failed:" "%t" "in line %l (errornumber %n)" "Ok" "" ""'
  170.       noselect='"FinalWrapper failed:" "Select an oval and a textblock or" "some text before calling FinalWrapper!" "Ok" "" ""'
  171.       fwerrtext.10='Instruction failed'
  172.       fwerrtext.20='Invalid arguments'
  173.       fwerrtext.100='Unknown instruction'
  174.       fwerrtext.200='Couldn''t open fwarexx.library'
  175.       nolib='"FinalWrapper failed:" "Couldn''t open ''%y''" "" "Ok" "" ""'
  176.       nofw='FinalWrapper failed: Final Writer not found!'
  177.       wrongos='"FinalWrapper failed:" "At least OS2.0 is needed!" "" "Ok" "" ""'
  178.       stillalive='"FinalWrapper is already running!" "" "" "Ok" "" ""'
  179.       nogui='"FinalWrapper failed:" "Couldn''t open requester!" "" "Ok" "" ""'
  180.     END
  181.   /* Don't change the following! */
  182.   info='FinalWrapper 2.1 by NDY''s'
  183.   wintitle=replacepat(wintitle,"%i",info)
  184.   labs.1=2
  185.   labs.2=2
  186.   labs.3=2
  187.   labs.4=3
  188.   labs.5=4
  189.   labs.6=4
  190.   labs.7=3
  191.   labs.8=4
  192.   DO i=9 TO 13
  193.     labs.i=0
  194.   END
  195.   IF test=4 | initerr=13 THEN
  196.     DO
  197.       SAY nofw
  198.       CALL bye(13)
  199.     END
  200.   IF test=1 | initerr=14 THEN
  201.     DO
  202.       ShowMessage 1 1 replacepat(nolib,"%y",library.libn)
  203.       CALL bye(14)
  204.     END
  205.   IF test=8 THEN
  206.     DO
  207.       ShowMessage 1 1 nogui
  208.       CALL bye(50)
  209.     END
  210.   /* Already running? */
  211.   portname="FinalWrapperPort"
  212.   IF Show("p",portname) | test=7 THEN
  213.     DO
  214.       ShowMessage 1 1 stillalive
  215.       /* Don't close libs! */
  216.       DO i=1 TO 3
  217.         lib.i=0
  218.       END
  219.       CALL bye(5)
  220.     END
  221.   /* Test errors */
  222.   IF test>5 THEN
  223.     DO
  224.       RC=test
  225.       IF test=6 THEN SIGNAL SYNTAX
  226.       SIGNAL ERROR
  227.     END
  228. RETURN
  229. PROC guiinit: /* Init interface. Returns 5 if failed [2.1] */
  230.   /* Already opened? */
  231.   IF cleangui THEN RETURN 0
  232.   /* OS 2.0 ? */
  233.   execbase=GETVALUE("4"x,0,4,"P")
  234.   osversion=GETVALUE(execbase,20,2,"N")
  235.   IF osversion<37 | test=3 THEN
  236.     DO
  237.       ShowMessage 1 1 wrongos
  238.       CALL bye(10)
  239.     END
  240.   /* Convert defaults */
  241.   IF Length(default)<52 THEN default=X2C("01000168 00010019 00010064 00020000 00020000 00030000 00020000 00030000 01000000 01000000 00000000 00000000 00000000")
  242.   DO id=1 TO 13
  243.     i=id*4
  244.     check.id=C2D(SubStr(default,i-3,1))~=0
  245.     cycle.id=Min(Max(C2D(SubStr(default,i-2,1)),0),labs.id)
  246.     val.id=Min(Max(C2D(SubStr(default,i-1,2)),0),9999)
  247.   END
  248.   /* Initialize constants */
  249.   scr=NULL() ; win=NULL() ; gad=NULL() ; scrvinfo=NULL() ; port=0
  250.   gads=16
  251.   cleangui=1
  252.   CALL SET_APIG_GLOBALS()
  253.   nullbyte=D2C(0)
  254.   /* Screen */
  255.   scr=LockPubScreen("")
  256.   IF scr=NULL() THEN RETURN 5
  257.   scrvinfo=GetVisualInfo(scr)
  258.   IF scrvinfo=NULL() THEN RETURN 5
  259.   scrfont=GETVALUE(scr,40,4,"P")
  260.   fonth=GETVALUE(scrfont,4,2,"N")
  261.   scrrp=D2C(C2D(scr)+84)
  262.   glistptr=MAKEPOINTER(0,0,4,MEMF_CLEAR)
  263.   IF glistptr=NULL() THEN RETURN 5
  264.   borderl=GETVALUE(scr,36,1,"N")
  265.   bordert=GETVALUE(scr,35,1,"N")+fonth+1
  266.   /* Figure out window size */
  267.   gadh=fonth+4
  268.   gaddy=gadh+2
  269.   maxwidth=0
  270.   intw=TextLength(scrrp,"77777"||nullbyte,-1)+12   /* 4 digits plus cursor */
  271.   addwidth=32+intw
  272.   DO id=1 TO 8
  273.     glabels.id=MAKEPOINTER(0,0,4*labs.id+4,MEMF_CLEAR)
  274.     IF glabels.id=NULL() THEN RETURN 5
  275.     DO i=1 TO labs.id /* last one must be null to terminate list */
  276.       lbuf.id.i=MAKEPOINTER(glabels.id,0,Length(ltxt.id.i)+1,MEMF_CLEAR)
  277.       IF lbuf.id.i=NULL() THEN RETURN 5
  278.       /* copy label text into buffer */
  279.       CALL Export(lbuf.id.i,ltxt.id.i)
  280.       /* set array slot to lbuf address */
  281.       CALL SETVALUE(glabels.id,(i-1)*4,4,"P",lbuf.id.i)
  282.       xwid=TextLength(scrrp,ltxt.id.i||nullbyte,-1)+30
  283.       IF id<6 THEN xwid=xwid+addwidth
  284.       maxwidth=Max(maxwidth,xwid)
  285.     END
  286.   END
  287.   DO id=9 TO 13
  288.     gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+34
  289.   END
  290.   DO id=14 TO 16
  291.     gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+6
  292.   END
  293.   maxwidth=Max(maxwidth,gwid.9+gwid.10+4)
  294.   maxwidth=Max(maxwidth,gwid.11+gwid.12+4)
  295.   maxwidth=Max(maxwidth,gwid.13+gwid.14+gwid.15+gwid.16+10)
  296.   winwid=maxwidth+4
  297.   winhi=11*gaddy+6
  298.   /* Initialize gadgets */
  299.   gadx=borderl+2
  300.   gady=bordert+1
  301.   gadw=maxwidth
  302.   gadmaxx=winwid+borderl-2
  303.   gadmaxy=winhi+bordert-1
  304.   DO id=1 TO 5
  305.     gadid=id*3
  306.     newgadxb.id=MAKENEWGADGET(scrvinfo,scrfont,gadx,gady+(id-1)*gaddy,28,gadh,"",0,gadid+1,NULL())
  307.     newgadxi.id=MAKENEWGADGET(scrvinfo,scrfont,gadmaxx-intw,gady+(id-1)*gaddy,intw,gadh,"",0,gadid+2,NULL())
  308.     newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gadx+30,gady+(id-1)*gaddy,gadw-addwidth,gadh,"",0,gadid,NULL())
  309.     IF newgadxb.id=NULL() | newgadxi.id=NULL() | newgadx.id=NULL() THEN RETURN 5
  310.   END
  311.   DO id=6 TO 8
  312.     newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gadx,gady+(id-1)*gaddy,gadw,gadh,"",0,id*3,NULL())
  313.     IF newgadx.id=NULL() THEN RETURN 5
  314.   END
  315.   DO id=9 TO 12
  316.     IF (id-9)//2 THEN
  317.       gx=gadmaxx-gwid.id
  318.     ELSE
  319.       gx=gadx
  320.     newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gady+(8+(id-9)%2)*gaddy,28,gadh,ltxt.id,PLACETEXT_RIGHT,id*3+1,NULL())
  321.   END
  322.   newgadx.13=MAKENEWGADGET(scrvinfo,scrfont,gadx,gadmaxy-gadh,28,gadh,ltxt.13,PLACETEXT_RIGHT,13*3+1,NULL())
  323.   gx=gadmaxx-gwid.14-gwid.15-gwid.16-8
  324.   DO id=14 TO 16
  325.     newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gadmaxy-gadh,gwid.id,gadh,ltxt.id,PLACETEXT_IN,id*3,NULL())
  326.     gx=gx+gwid.id+4
  327.   END
  328.   DO id=9 TO 16
  329.     IF newgadx.id=NULL() THEN RETURN 5
  330.   END
  331.   /* Create'em */
  332.   gad=CreateContext(glistptr)
  333.   cyclegad.1=gad
  334.   DO id=1 TO 5
  335.     x=Max(id-1,1)
  336.     checkgad.id=CreateGadget(CHECKBOX_KIND,cyclegad.x,newgadxb.id,GTCB_CHECKED,check.id,TAG_DONE,0)
  337.     intgad.id=CreateGadget(INTEGER_KIND,checkgad.id,newgadxi.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,4,TAG_DONE,0)
  338.     cyclegad.id=CreateGadget(CYCLE_KIND,intgad.id,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  339.   END
  340.   DO id=6 TO 8
  341.     x=id-1
  342.     cyclegad.id=CreateGadget(CYCLE_KIND,cyclegad.x,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  343.   END
  344.   checkgad.8=cyclegad.8
  345.   DO id=9 TO 13
  346.     x=id-1
  347.     checkgad.id=CreateGadget(CHECKBOX_KIND,checkgad.x,newgadx.id,GTCB_CHECKED,check.id,TAG_DONE,0)
  348.   END
  349.   DO id=14 TO 16
  350.     x=id-1
  351.     checkgad.id=CreateGadget(BUTTON_KIND,checkgad.x,newgadx.id,TAG_DONE,0)
  352.   END
  353.   IF checkgad.16=NULL() THEN RETURN 5 /* ANY gadget not created */
  354.   /* Open window */
  355.   winidcmp=IDCMP_CLOSEWINDOW+IDCMP_GADGETUP+IDCMP_ACTIVEWINDOW+IDCMP_MOUSEBUTTONS+IDCMP_RAWKEY
  356.   winflags=WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+WFLG_DRAGBAR+WFLG_ACTIVATE
  357.   port=OpenPort(portname)
  358.   IF ~port THEN RETURN 5
  359.   /* Centered beneath mouseptr */
  360.   ymouse=GETVALUE(scr,16,2,"N")
  361.   xmouse=GETVALUE(scr,18,2,"N")
  362.   /* taglist */
  363.   wtagl=MAKEPOINTER(0,0,88,MEMF_CLEAR)
  364.   IF wtagl=NULL() THEN RETURN 5
  365.   wname=MAKEPOINTER(wtagl,0,Length(wintitle)+1,MEMF_CLEAR)
  366.   IF wname=NULL() THEN RETURN 5
  367.   CALL Export(wname,wintitle)
  368.   wzipdims=MAKEPOINTER(wtagl,0,8,MEMF_CLEAR)
  369.   IF wzipdims=NULL() THEN RETURN 5
  370.   CALL SETVALUE(wzipdims,4,2,"N",winwid)
  371.   CALL SETVALUE(wzipdims,6,2,"N",bordert)
  372.   CALL SETTAGSLOT(wtagl,0,WA_LEFT,"N",Max(xmouse-winwid/2,0))
  373.   CALL SETTAGSLOT(wtagl,1,WA_TOP,"N",Max(ymouse-winhi/2,0))
  374.   CALL SETTAGSLOT(wtagl,2,WA_INNERWIDTH,"N",winwid)
  375.   CALL SETTAGSLOT(wtagl,3,WA_INNERHEIGHT,"N",winhi)
  376.   CALL SETTAGSLOT(wtagl,4,WA_IDCMP,"N",winidcmp)
  377.   CALL SETTAGSLOT(wtagl,5,WA_FLAGS,"N",winflags)
  378.   CALL SETTAGSLOT(wtagl,6,WA_TITLE,"P",wname)
  379.   CALL SETTAGSLOT(wtagl,7,WA_GADGETS,"P",gad)
  380.   CALL SETTAGSLOT(wtagl,8,WA_PUBSCREEN,"P",scr)
  381.   CALL SETTAGSLOT(wtagl,9,WA_ZOOM,"P",wzipdims)
  382.   CALL SETTAGSLOT(wtagl,10,TAG_DONE,"N",0)
  383.   win=OpenWindowTagList(portname,NULL(),wtagl,0)
  384.   IF win=NULL() THEN RETURN 5
  385.   rp=GETWINDOWRASTPORT(win)
  386.   CALL DrawBevelBox(rp,gadx,gadmaxy-gadh-5,gadw,2,GTBB_RECESSED,-1,TAG_DONE,0)
  387.   CALL GT_RefreshWindow(win,NULL())
  388. RETURN 0
  389. PROC gui: /* Check gadgets [2.1] */
  390.   IF check.10 THEN CALL ScreenToFront(scr)
  391.   closed=0
  392.   DO WHILE closed=0
  393.     CALL WaitPkt(portname)
  394.     CALL messy
  395.   END
  396.   IF check.10 THEN CALL ScreenToBack(scr)
  397.   IF (check.13 | check.11) & closed~=3 THEN
  398.     DO
  399.       default=""
  400.       DO id=1 TO 12
  401.         default=default||D2C(check.id,1)||D2C(cycle.id,1)||D2C(val.id,2)
  402.       END
  403.       default=default||D2C(0,4)
  404.       DO i=1 TO 1+check.13
  405.         ok=Open(prefs,preff.i,"W")
  406.         IF ok THEN
  407.           DO
  408.             CALL WriteCh(prefs,default)
  409.             CALL Close(prefs)
  410.           END
  411.       END
  412.     END
  413.   ELSE
  414.     IF closed=4 THEN
  415.       DO
  416.         ok=Open(prefs,preff.2,"R")
  417.         IF ~ok THEN CALL bye(0)
  418.         default=ReadCh(prefs,52)
  419.         CALL Close(prefs)
  420.         IF Length(default)<52 THEN CALL bye(0)
  421.         ok=Open(prefs,preff.1,"W")
  422.         CALL WriteCh(prefs,default)
  423.         CALL Close(prefs)
  424.       END
  425.   IF closed>2 THEN CALL bye(0)
  426. RETURN 0
  427. PROC messy: /* Process messages [2.1] */
  428.   IF port=0 THEN RETURN
  429.   DO FOREVER
  430.     msg=GetPkt(portname)
  431.     IF msg='0000 0000'x THEN LEAVE
  432.     msgclass=GetArg(msg,0)
  433.     code=GetArg(msg,1)
  434.     qual=GetArg(msg,2)
  435.     gadid=GetArg(msg,9)
  436.     CALL Reply(msg,0)
  437.     IF msgclass=IDCMP_RAWKEY THEN
  438.       DO
  439.         id=code-79
  440.         SELECT
  441.           WHEN id<14 & id>0 THEN  /* F-keys */
  442.             DO
  443.               msgclass=IDCMP_GADGETUP
  444.               type=(qual//4)//3
  445.               IF id>8 THEN type=1
  446.               gadid=id*3+type
  447.               IF type=2 THEN CALL ActivateGadget(intgad.id,win,NULL())
  448.               IF type=1 THEN code=~check.id
  449.               IF (id<6 | id>8) & type=1 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,NULL(),GTCB_CHECKED,code)
  450.               IF type=0 THEN code=(cycle.id+1)//labs.id
  451.               IF id<9 & type=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,NULL(),GTCY_ACTIVE,code)
  452.             END
  453.           WHEN code>66 & code<71 THEN closed=code-66 /* Enter|Return|Esc|Del */
  454.           OTHERWISE NOP
  455.         END
  456.       END
  457.     SELECT
  458.       WHEN msgclass=IDCMP_CLOSEWINDOW THEN closed=4
  459.       WHEN check.9 & (msgclass=IDCMP_ACTIVEWINDOW | msgclass=IDCMP_MOUSEBUTTONS) THEN CALL ActivateGadget(intgad.1,win,NULL())
  460.       WHEN msgclass=IDCMP_GADGETUP THEN
  461.         DO
  462.           type=gadid//3
  463.           id=gadid%3
  464.           SELECT
  465.             WHEN id>13 THEN closed=id-13 /* Ok | Go | Cancel */
  466.             WHEN type=2 THEN /* Integer */
  467.               DO
  468.                 old=val.id
  469.                 specialinfo=GETVALUE(intgad.id,34,4,"P")
  470.                 val.id=GETVALUE(specialinfo,28,4,"N")
  471.                 check.id=check.9 | check.id | old~=val.id
  472.                 IF old~=val.id | check.9 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,NULL(),GTCB_CHECKED,check.id)
  473.               END
  474.             WHEN type=1 THEN  /* Checkbox */
  475.               DO
  476.                 check.id=code
  477.                 IF id<6 & check.id~=0 & check.9 THEN CALL ActivateGadget(intgad.id,win,NULL())
  478.               END
  479.             OTHERWISE /* Cycle */
  480.               DO
  481.                 cycle.id=code
  482.                 check.id=1
  483.                 IF id<6 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,NULL(),GTCB_CHECKED,check.id)
  484.                 IF id<6 & check.9 THEN CALL ActivateGadget(intgad.id,win,NULL())
  485.               END
  486.           END
  487.         END
  488.       OTHERWISE NOP
  489.     END
  490.   END
  491. RETURN
  492. PROC guiclean: /* Clean up GUI [2.1] */
  493.   IF cleangui THEN
  494.     DO
  495.       IF scr~=NULL() THEN CALL UnLockPubScreen(NULL(),scr)
  496.       IF win~=NULL() THEN CALL CloseWindow(win)
  497.       IF gad~=NULL() THEN CALL FreeGadgets(gad)
  498.       IF scrvinfo~=NULL() THEN CALL FreeVisualInfo(scrvinfo)
  499.       IF port THEN CALL ClosePort(portname)
  500.       port=0
  501.       /* Free allocated structures (some were maybe not allocated, but APIG handles this) */
  502.       DO id=1 TO gads
  503.         CALL FREETHIS(newgadx.id)
  504.         CALL FREETHIS(newgadxi.id)
  505.         CALL FREETHIS(newgadxb.id)
  506.         CALL FREETHIS(glabels.id)
  507.       END
  508.       CALL FREETHIS(wtagl)
  509.       CALL FREETHIS(glistptr)
  510.       cleangui=0
  511.     END
  512. RETURN
  513. PROC chosenobjs: /* Selected objects. Returns 0, if OK [2.1] */
  514.   /* Selected objects */
  515.   ovalrescan=0
  516.   txtrescan=0
  517.   txt=0
  518.   oval=0
  519.   len=0
  520.   FirstObject "SELECTED"
  521.   o=RESULT
  522.   IF o~=0 THEN
  523.     DO
  524.       cnt=0
  525.       DO UNTIL o=0
  526.         gobj.cnt=o
  527.         NextObject o "SELECTED"
  528.         o=RESULT
  529.         cnt=cnt+1
  530.       END
  531.       /* Search oval and textblock */
  532.       DO i=0 TO cnt-1 WHILE oval=0 | txt=0
  533.         GetObjectType gobj.i
  534.         IF RESULT=7 THEN txt=gobj.i
  535.         IF RESULT=6 THEN oval=gobj.i
  536.       END
  537.     END
  538.   /* Selected text */
  539.   IF txt=0 THEN
  540.     DO
  541.       Status "PARAPOS"
  542.       pos=RESULT
  543.       IF Words(pos)=4 THEN
  544.         DO
  545.           Extract
  546.           text=RESULT
  547.           MoveToPara Word(pos,1) Word(pos,2)
  548.           len=Length(text)
  549.           txtrescan=1
  550.         END
  551.       ELSE
  552.         IF rescan THEN
  553.           DO
  554.             IF Word(pos,2)~=0 THEN MoveToPara Word(pos,1) 0
  555.             Status "PARACHARS"
  556.             len=RESULT
  557.             text=""
  558.             txtrescan=1
  559.           END
  560.     END
  561.   IF oval=0 THEN
  562.     oval=oldoval
  563.   ELSE
  564.     ovalrescan=1
  565.   IF txt=0 & len=0 THEN
  566.      objs=oldobjs
  567.   ELSE
  568.      txtrescan=1
  569.   IF len=0 THEN len=oldlen
  570.   IF txt=0 & txtrescan=0 THEN txt=oldtxt
  571.   IF (txt=0 & len=0 | oval=0 | test=2) & test~=3 THEN
  572.     DO
  573.       ShowMessage 1 1 noselect
  574.       IF closed~=2 THEN
  575.         CALL bye(5)
  576.       ELSE
  577.         RETURN 5
  578.     END
  579.   oldoval=oval
  580.   oldtxt=txt
  581.   oldlen=len
  582.   oldobjs=objs
  583. RETURN 0
  584. PROC options: /* Process inputs [2.1] */
  585.   /* Defaults: */
  586.   ssize=360
  587.   rdim=""
  588.   hdim=""
  589.   start="+0"
  590.   rrot=""
  591.   /* Convert vars */
  592.   IF check.1 THEN ssize=SubStr("+-",cycle.1+1,1)||val.1
  593.   IF check.2 THEN rdim=SubStr("-+",cycle.2+1,1)||val.2
  594.   IF check.3 THEN hdim=SubStr("-+",cycle.3+1,1)||val.3
  595.   IF check.4 THEN start=SubStr("-+",cycle.4+1,1)||val.4
  596.   IF check.5 THEN
  597.     IF cycle.5=3 & txt>0 THEN
  598.       rrot="="
  599.     ELSE
  600.       rrot=SubStr("+-",cycle.5+1,1)||val.5
  601.   del=SubStr("+-=",cycle.6+1,1)
  602.   grp=SubStr("+-",cycle.7+1,1)
  603.   adjust=SubStr("+-=",cycle.8+1,1)
  604.   rescan=check.12 | rescan
  605.   /* Correct inputs */
  606.   IF ssize=0 THEN ssize=0.01 /* no division by zero */
  607.   absstart=0
  608.   IF Verify(Left(start,1),"+-","m")=0 THEN
  609.     DO
  610.       absstart=1
  611.       start=Max(Min(start,360),0)
  612.     END
  613.   ELSE
  614.     start=Max(Min(start,180),-180)
  615.   IF rdim="" THEN
  616.     ssize=Max(Min(ssize,360),-360)
  617.   ELSE
  618.     rdim=Max(Min(rdim,100),-100)
  619.   IF rdim=0 THEN rdim=0.01
  620.   IF hdim="" THEN
  621.     hdim=rdim
  622.   ELSE
  623.     hdim=Max(Min(hdim,100),-100)
  624.   IF hdim=0 THEN hdim=0.01
  625.   /* Relative rotation */
  626.   drot=0
  627.   IF Verify(Left(rrot,1),"+-","m")>0 THEN
  628.     DO
  629.       IF Length(rrot)=1 THEN
  630.         drot=rrot||"90"
  631.       ELSE
  632.         drot=Max(Min(rrot,180),-180)
  633.       rrot=""
  634.     END
  635.   ELSE
  636.     IF rrot~="" & rrot~="=" THEN rrot=Max(Min(rrot,360),-360)
  637. RETURN
  638. PROC pointnoval: /* Decimal point & process oval [2.1] */
  639.   /* Use decimal point */
  640.   GetDocItemPrefs "DECIMAL"
  641.   deci=RESULT
  642.   DocItemPrefs "DECIMAL PERIOD"
  643.   /* Examine oval */
  644.   IF ovalrescan THEN
  645.     DO
  646.       GetObjectRotation oval
  647.       orot=RESULT
  648.       GetObjectCoords oval
  649.       PARSE VAR RESULT page x y rx ry
  650.       rx=rx/2
  651.       ry=ry/2
  652.       xm=x+rx
  653.       ym=y+ry
  654.       /* Use oval's text flow settings */
  655.       GetObjectParams oval "TEXTFLOW FLOWDIST"
  656.       flow=Word(RESULT,1)
  657.       IF Left(flow,5)="Right" THEN
  658.         flow="Right"
  659.       ELSE
  660.         IF Left(flow,4)="Left" THEN flow="Left"
  661.       fld=Word(RESULT,2)
  662.       IF orot~=0 THEN SetObjectRotation oval 0
  663.       IF del="=" THEN
  664.         DO
  665.           SelectObject oval
  666.           Copy
  667.         END
  668.       IF del~="-" & grp="" THEN DeleteObject oval
  669.     END
  670.   TextBlockPrefs "TEXTFLOW" flow "FLOWDIST" fld
  671. RETURN
  672. PROC textblock: /*  Process textblock [2.1] */
  673.   /* Examine textblock */
  674.   IF txtrescan THEN
  675.     DO
  676.       GetTextBlockText txt
  677.       text=RESULT
  678.       text=rembad(text)
  679.       len=Length(text)
  680.       oldlen=len
  681.       GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  682.       PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  683.       GetObjectCoords txt
  684.       txtw=Word(RESULT,4)
  685.       h=Word(RESULT,5)
  686.       /* Get rotation */
  687.       IF rrot="=" THEN
  688.         DO
  689.           GetObjectRotation txt
  690.           rrot=RESULT
  691.         END
  692.       IF del="+" THEN DeleteObject txt
  693.     END
  694.   TextBlockTypePrefs "SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl "COLOR" tcol "FONT" tfont
  695. RETURN
  696. PROC bodytext: /* Process selected text [2.1] */
  697.   IF ~txtrescan THEN RETURN
  698.   IF rrot="=" THEN rrot=0
  699.   txtw=0
  700.   /* Remove CR at the end */
  701.   IF C2X(Right(text,1))="0A" THEN
  702.     DO
  703.       len=len-1
  704.       text=Left(text,len)
  705.     END
  706.   text=rembad(text)
  707.   /* Create textobjects */
  708.   noextr=text>""
  709.   DO i=1 TO len
  710.     IF noextr THEN
  711.       x=SubStr(text,i,1)
  712.     ELSE
  713.       DO
  714.         Extract
  715.         x=rembad(RESULT)
  716.         text=text||x
  717.       END
  718.     DO
  719.       Cursor "RIGHT"
  720.       specs.i=gettexttypespecs()
  721.     END
  722.     TextBlockTypePrefs specs.i
  723.     IF Verify(x,'";= ',"M")  THEN x='"'||x||'"'
  724.     DrawTextBlock page xm ym x
  725.     /* Save size & number */
  726.     objs=objs+1
  727.     GetObjectCoords 0
  728.     PARSE VAR RESULT x x x objw.objs objh.objs
  729.     txtw=txtw+objw.objs
  730.     CurrentObject
  731.     obj.i=RESULT
  732.     /* Have a look at the requester */
  733.     IF closed=2 THEN
  734.       DO
  735.         CALL messy
  736.         IF closed>2 THEN
  737.           DO
  738.             CALL remobjs
  739.             closed=2
  740.             broken=1
  741.             oldlen=0
  742.             rescan=2
  743.             oldobjs=0
  744.             RETURN
  745.           END
  746.         ELSE
  747.           IF closed=1 THEN closed=2
  748.       END
  749.   END
  750. RETURN
  751. PROC initwrap: /* Init wrapping [2.1] */
  752.   PI=3.141593
  753.   smin=0.1 /* Minimal size */
  754.   sizerad=ssize/180*PI
  755.   angstep=sizerad/txtw
  756.   IF absstart THEN
  757.     angstart=start/180*PI
  758.   ELSE
  759.     angstart=(ssize-360+start*2)/360*PI
  760.   adone=angstart
  761.   flip=Sign(ssize)
  762.   ssize=ssize<0
  763.   fr=0
  764.   IF rdim="" THEN
  765.     qr=1
  766.   ELSE
  767.     DO
  768.       fr=(1-Abs(rdim)/100)/sizerad*Sign(rdim)
  769.       IF rdim<0 THEN
  770.         fr0=Abs(rdim)/100
  771.       ELSE
  772.         fr0=1
  773.     END
  774.   IF hdim="" THEN
  775.     qh=1
  776.   ELSE
  777.     DO
  778.       fh=(1-Abs(hdim)/100)/sizerad*Sign(hdim)
  779.       IF hdim<0 THEN
  780.         fh0=Abs(hdim)/100
  781.       ELSE
  782.         fh0=1
  783.     END
  784.   wdone=0
  785.   o=0
  786. RETURN
  787. PROC wrap: /* Wrap it! [2.1] */
  788.   DO n=1 TO len
  789.     char=SubStr(text,n,1)
  790.     IF Verify(char,'";= ',"M")  THEN char='"'||char||'"'
  791.     IF txt>0 & txtrescan THEN
  792.       DO
  793.         /* Draw and get size */
  794.         DrawTextBlock page xm ym char
  795.         GetObjectCoords 0
  796.         objw.n=Word(RESULT,4)
  797.         objh.n=h
  798.         CurrentObject
  799.         objs=objs+1
  800.         obj.n=RESULT
  801.       END
  802.     /* Number and size saved before */
  803.     cw=objw.n
  804.     ch=objh.n
  805.     o=obj.n
  806.     /* What's done so far */
  807.     f=angstart-angstep*(wdone+cw/2)
  808.     wdone=wdone+cw
  809.     /* Adjusting */
  810.     IF adjust="=" THEN
  811.       DO
  812.         asize=cw/radius(adone,rx,ry,fr)
  813.         f=adone-asize/2*flip
  814.         adone=adone-asize*flip
  815.       END
  816.     ELSE
  817.       IF adjust~="" THEN
  818.         DO
  819.           carc=radius(f,rx,ry,fr)*angstep*cw
  820.           IF adjust="+" THEN ch=ch/cw*carc
  821.           cw=carc
  822.         END
  823.     /* Spirals */
  824.     IF rdim~="" THEN qr=fr0+fr*(f-angstart)
  825.     IF hdim~="" THEN
  826.       DO
  827.         qh=fh0+fh*(f-angstart)
  828.         ch=Max(ch*qh,smin)
  829.         cw=Max(cw*qh,smin)
  830.       END
  831.     x=rx*Sin(f)*qr-cw/2
  832.     y=ry*Cos(f)*qr-ch/2
  833.     /* Rotation */
  834.     IF rrot="" THEN
  835.       rot=720-Trunc(Atan(ry/rx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)+drot
  836.       /* Circles only: rot=Trunc(ssize*180+180-f/PI*180)+drot */
  837.     ELSE
  838.       rot=rrot
  839.     rot=rot//360
  840.     /* Centre char on the oval */
  841.     IF ~txtrescan THEN
  842.       DO
  843.         IF txt=0 THEN TextBlockTypePrefs specs.n
  844.         DrawTextBlock page x+xm y+ym char
  845.         CurrentObject
  846.         objs=objs+1
  847.         obj.n=RESULT
  848.         o=obj.n
  849.         IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords o page x+xm y+ym cw ch
  850.       END
  851.     ELSE
  852.       SetObjectCoords o page x+xm y+ym cw ch
  853.     SetObjectRotation o rot
  854.     /* Have a look at the requester */
  855.     IF closed=2 THEN
  856.       DO
  857.         CALL messy
  858.         IF closed>2 THEN
  859.           DO
  860.             CALL remobjs
  861.             closed=2
  862.             broken=1
  863.             IF txt>0 & txtrescan THEN
  864.               DO
  865.                 oldtxt=0
  866.                 oldlen=0
  867.                 oldobjs=0
  868.                 rescan=2
  869.               END
  870.             RETURN
  871.           END
  872.         ELSE
  873.           IF closed=1 THEN closed=2
  874.       END
  875.   END
  876. RETURN
  877. PROC group: /* Group objects [2.1] */
  878.   /* Hide oval */
  879.   IF grp="-" THEN
  880.     DO
  881.       SelectObject oval
  882.       SetObjectParams oval "LINEWT NONE FILL TRANSPARENT"
  883.     END
  884.   /* Rotate oval back */
  885.   IF orot~=0 & del="-" & grp="" THEN SetObjectRotation oval orot
  886.   /* Group chars */
  887.   SelectObject
  888.   DO n=1 TO objs
  889.     SelectObject obj.n "MULTIPLE"
  890.   END
  891.   IF grp~="" & ovalrescan THEN SelectObject oval "MULTIPLE"
  892.   Group
  893.   objs=0
  894.   IF orot~=0 & ovalrescan THEN SetObjectRotation 0 orot
  895.   Redraw
  896. RETURN
  897. PROC bye: /* CALL bye(returnvalue)  You MUST use this instead of EXIT! [2.1] */
  898.   PARSE ARG errnr
  899.   /* Restore decimal delimitter */
  900.   IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  901.   CALL guiclean
  902.   DO i=1 TO 3
  903.     IF lib.i THEN CALL RemLib(library.i)
  904.   END
  905.   CALL remobjs
  906.   EXIT errnr
  907. RETURN
  908. PROC remobjs: /* Delete drawn objects [2.1] */
  909.   IF objs>0 THEN
  910.     DO
  911.       SelectObject
  912.       DO n=1 TO objs
  913.         SelectObject obj.n "MULTIPLE"
  914.       END
  915.       Group
  916.       DeleteObject
  917.       objs=0
  918.     END
  919. RETURN
  920. PROC SYNTAX: /* SYNTAX & ERROR handling [1.3] */
  921.   et=ErrorText(RC)
  922. ERROR:
  923.   line=SIGL
  924.   nr=RC
  925.   IF et="" THEN et=fwerrtext.nr
  926.   IF nr>5 THEN ShowMessage 1 1 replacepat(replacepat(replacepat(errtext,"%n",nr),"%l",line),"%t",et)
  927.   CALL bye(nr)
  928. RETURN
  929. PROC rembad: PROCEDURE /* newstr=rembad(str) [1.1] */
  930.   /* Replace unprintable characters by spaces */
  931.   PARSE ARG t
  932.   bad=XRange("00"x,"1F"x)||XRange("7F"x,"9F"x)
  933.   i=Verify(t,bad,"m")
  934.   l=Length(t)
  935.   DO WHILE i>0
  936.     t=Left(t,i-1) Right(t,l-i)
  937.     i=Verify(t,bad,"m")
  938.   END
  939. RETURN t
  940. PROC replacepat: PROCEDURE /* newstr=replacepat(str,pat,replc) [1.2] */
  941.   /* Replace all occurences of a pattern in a string by another one */
  942.   PARSE ARG str,pat,replc
  943.   p=Pos(pat,str)
  944.   DO WHILE p>0
  945.     str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  946.     p=Pos(pat,str)
  947.   END
  948. RETURN str
  949. PROC getlanguage: PROCEDURE /* language=getlanguage() [2.1] */
  950.   /* Get preferred language */
  951.   ok=Open(prefs,"ENV:Language","R")
  952.   IF ok THEN
  953.     DO
  954.       language=ReadLn(prefs)
  955.       CALL Close(prefs)
  956.     END
  957. RETURN language
  958. PROC gettexttypespecs: PROCEDURE /*  specs=gettexttypespecs() [1.3] */
  959.   Status "FONTSIZE"
  960.   p="SIZE" RESULT
  961.   Status "FONTLEADING"
  962.   p=p "LEADING" RESULT
  963.   Status "FONTWIDTH"
  964.   p=p "WIDTH" RESULT
  965.   Status "FONTOBLIQUE"
  966.   p=p "OBLIQUE" RESULT
  967.   Status "FONTPOSITION"
  968.   p=p "POSITION" RESULT
  969.   Status "FONTCASE"
  970.   p=p "CASE" RESULT
  971.   Status "FONTSTYLE"
  972.   p=p "STYLE" RESULT
  973.   Status "FONTCOLOR"
  974.   p=p "COLOR" RESULT
  975.   Status "FONTNAME"
  976.   p=p "FONT" RESULT
  977. RETURN p
  978. PROC radius: PROCEDURE /* rad=radius(angle,rx,ry,v) [1.4] */
  979.   ARG a,rx,ry,v
  980.   rx=rx*Cos(a)
  981.   ry=ry*Sin(a)
  982.   r=(1-a*v)*Sqrt(rx*rx+ry*ry)
  983. RETURN r
  984. PROC dump: PROCEDURE /* CALL dump(var[,infostr]) [1.3] */
  985.   /* Dump a variable, %v in infostring determines it's place (debug-only) */
  986.   PARSE ARG v,info
  987.   IF info="" THEN info="%v"
  988.   ShowMessage 1 1 '"'||replacepat(info,"%v",v)||'" "" "" "Ok" "" ""'
  989. RETURN
  990.