home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / WordProcessors / UNT-AXFW.LHA / fwmacros / FinalWaver.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-06-15  |  8.3 KB  |  327 lines
  1. /* $VER: FinalWaver 1.0 (10.05.94) by NDY's */
  2.  
  3. /* Main [1.0] */
  4. OPTIONS RESULTS
  5. SIGNAL ON ERROR
  6. SIGNAL ON SYNTAX
  7. CALL init
  8. CALL locale
  9. CALL chosenobjs
  10. CALL options
  11. CALL point
  12. IF txt>0 THEN
  13.   CALL textblock
  14. ELSE
  15.   CALL bodytext
  16. CALL wave
  17. CALL group
  18. CALL bye
  19.  
  20. PROC init: /* Initialization [1.0] */
  21.   /* Vars needed by "bye" / "ERROR" */
  22.   errtext='"%t" "(#%n) in line %l" "" "Ok" "" ""'
  23.   objs=0
  24.   deci=""
  25.   et=""
  26.   /* Open library */
  27.   library="rexxmathlib.library"
  28.   lib=Show("l",library)
  29.   IF ~lib THEN lib=AddLib(library,0,-30,0)
  30.   IF ~lib | test=1 THEN
  31.     DO
  32.       ShowMessage 1 1 replacepat(nolib,"%y",library)
  33.       CALL bye(14)
  34.     END
  35.   clip="FWaver.def"
  36.   default=GetClip(clip)
  37. RETURN
  38. PROC locale: /* Language specific strings [1.0] */
  39.   test=0  /* test 1/2/3/6/10/20/100/200 with new languages, 0 = no test */
  40.   lang=getlanguage()
  41.   info='FinalWaver 1.0 by NDY''s'
  42.   /* IF default='' THEN default='(put your defaults here and uncomment this line)' */
  43.   IF lang="deutsch" THEN /* German */
  44.     DO
  45.       errtext='"FinalWaver-Fehler:" "%t" "in Zeile %l (Fehlernummer %n)" "Ok" "" ""'
  46.       input='"%i" "Wellen und Höhe eingeben (? für Hilfe)" "%d"'
  47.       help.0='"Syntax (Argumente optional): [Wn] [A±n|An] [?]" "W: Anzahl Sinuswellen. Voreinstellung: 1" "A: Amplidude, - spiegelt die Welle. Voreinst.: 1"'
  48.       helpbutton='"Letzte Seite" "Zurück" "Nächste Seite"'
  49.       helppages=1
  50.       fwerrtext.10='Befehl gescheitert'
  51.       fwerrtext.20='Ungültige Argumente'
  52.       fwerrtext.100='Befehl unbekannt'
  53.       fwerrtext.200='Kann fwarexx.library nicht öffnen'
  54.       nolib='"FinalWaver-Fehler:" "Konnte ''%y'' nicht öffnen!" "" "Ok" "" ""'
  55.     END
  56.   ELSE /* Default: English */
  57.     DO
  58.       errtext='"FinalWaver failed:" "%t" "in line %l (errornumber %n)" "Ok" "" ""'
  59.       input='"%i" "Enter waves and height (? for help)" "%d"'
  60.       help.0='"Syntax (arguments optional): [Wn] [A±n|An] [?]" "W: Number of sinewaves. Default: 1" "A: Amplitude, - flips the wave. Default: 1"'
  61.       helpbutton='"Previous" "Back" "Next"'
  62.       helppages=1
  63.       fwerrtext.10='Instruction failed'
  64.       fwerrtext.20='Invalid arguments'
  65.       fwerrtext.100='Unknown instruction'
  66.       fwerrtext.200='Couldn''t open fwarexx.library'
  67.       nolib='"FinalWaver failed:" "Couldn''t open ''%y''" "" "Ok" "" ""'
  68.     END
  69.   input=replacepat(input,"%i",info)
  70.   IF test>5 THEN
  71.     DO
  72.       RC=test
  73.       IF test=6 THEN SIGNAL SYNTAX
  74.       SIGNAL ERROR
  75.     END
  76. RETURN
  77. PROC chosenobjs: /* Selected objects [1.0] */
  78.   /* Selected objects */
  79.   txt=0
  80.   oval=0
  81.   len=0
  82.   FirstObject "SELECTED"
  83.   o=RESULT
  84.   IF o~=0 THEN
  85.     DO
  86.       cnt=0
  87.       DO UNTIL o=0
  88.         obj.cnt=o
  89.         NextObject o "SELECTED"
  90.         o=RESULT
  91.         cnt=cnt+1
  92.       END
  93.       /* Search textblock */
  94.       DO i=0 TO cnt-1 WHILE txt=0
  95.         GetObjectType obj.i
  96.         IF RESULT=7 THEN txt=obj.i
  97.       END
  98.     END
  99.   /* Selected text */
  100.   IF txt=0 THEN
  101.     DO
  102.       Status "PARAPOS"
  103.       pos=RESULT
  104.       IF Words(pos)=4 THEN
  105.         DO
  106.           Extract
  107.           text=RESULT
  108.           MoveToPara Word(pos,1) Word(pos,2)
  109.           len=Length(text)
  110.         END
  111.       ELSE
  112.         DO
  113.           MoveToPara Word(pos,1) 0
  114.           Status "PARACHARS"
  115.           len=RESULT
  116.           text=""
  117.         END
  118.     END
  119.   IF len=0 & txt=0 THEN CALL bye(0)
  120. RETURN
  121. PROC options: /* Input [1.0] */
  122.   about=0
  123.   DO UNTIL about=-1 & test~=3
  124.     RequestText replacepat(input,"%d",default)
  125.     /* Help */
  126.     IF Pos("?",RESULT)>0 | test=3 THEN
  127.       DO
  128.         default=replacepat(RESULT,"?","")
  129.         about=0
  130.         DO UNTIL RESULT=2
  131.           ShowMessage 2 0 help.about helpbutton
  132.           about=(about+RESULT-2+helppages)//helppages
  133.         END
  134.       END
  135.     ELSE
  136.       about=-1
  137.   END
  138.   RESULT=replacepat(RESULT,",",".")
  139.   PARSE UPPER VAR RESULT "W" waves " ","A" amp " "
  140.   CALL SetClip(clip,Upper(RESULT))
  141.   /* Verify and set defaults (x||"0": ± -> ±0) */
  142.   IF ~Datatype(waves,"N") | waves="" THEN waves=1
  143.   waves=Max(waves,1)
  144.   IF amp="-" THEN amp=-1
  145.   IF ~Datatype(amp,"N") | amp="" THEN amp=1
  146. RETURN
  147. PROC point: /* Decimal point [1.0] */
  148.   /* Use decimal point */
  149.   GetDocItemPrefs "DECIMAL"
  150.   deci=RESULT
  151.   DocItemPrefs "DECIMAL PERIOD"
  152. RETURN
  153. PROC textblock: /* Process textblock [1.0] */
  154.   spcs=0
  155.   /* Examine textblock */
  156.   GetTextBlockText txt
  157.   text=RESULT
  158.   text=rembad(text)
  159.   len=Length(text)
  160.   GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  161.   PARSE VAR RESULT size lead wid obl pos case st col font
  162.   TextBlockTypePrefs "SIZE" size "LEADING" lead "WIDTH" wid "OBLIQUE" obl "POSITION" pos "CASE" case "STYLE" st "COLOR" col "FONT" font
  163.   GetObjectCoords txt
  164.   PARSE VAR RESULT page xx yy txtw h
  165. RETURN
  166. PROC bodytext: /* Process selected text [1.0] */
  167.   /* Get page size */
  168.   GetPageSetup "WIDTH HEIGHT"
  169.   PARSE VAR RESULT w h
  170.   Status 'PAGE "INSERT"'
  171.   page=RESULT
  172.   xx=w/2
  173.   yy=h/2
  174.   txtw=0
  175.   /* Remove CR at the end */
  176.   IF C2X(Right(text,1))="0A" THEN
  177.     DO
  178.       len=len-1
  179.       text=Left(text,len)
  180.     END
  181.   text=rembad(text)
  182.   /* Create textobjects */
  183.   DO i=1 TO len
  184.     IF text>"" THEN
  185.       x=SubStr(text,i,1)
  186.     ELSE
  187.       DO
  188.         Extract
  189.         x=RESULT
  190.       END
  191.     Cursor "RIGHT"
  192.     specs=gettexttypespecs()
  193.     TextBlockTypePrefs specs
  194.     IF Verify(x,'";= ',"M")  THEN x='"'||x||'"'
  195.     DrawTextBlock page xx yy x
  196.     /* Save size & number */
  197.     objs=objs+1
  198.     GetObjectCoords 0
  199.     PARSE VAR RESULT x x x objw.objs objh.objs
  200.     txtw=txtw+objw.objs
  201.     CurrentObject
  202.     obj.objs=RESULT
  203.   END
  204. RETURN
  205. PROC wave: /* Wave it! [1.0] */
  206.   PI=3.141593
  207.   angstep=waves*2*PI/txtw
  208.   wdone=0
  209.   f=0
  210.   o=0
  211.   nr=0
  212.   DO n=1 TO len
  213.     char=SubStr(text,n,1)
  214.     IF txt>0 THEN
  215.       DO
  216.         /* Draw and get size */
  217.         IF Verify(char,'";= ',"M")  THEN char='"'||char||'"'
  218.         DrawTextBlock page xx yy char
  219.         GetObjectCoords 0
  220.         cw=Word(RESULT,4)
  221.         ch=h
  222.         CurrentObject
  223.         objs=objs+1
  224.         obj.objs=RESULT
  225.       END
  226.     ELSE
  227.       DO
  228.         /* Number and size saved before */
  229.         nr=nr+1
  230.         cw=objw.nr
  231.         ch=objh.nr
  232.         o=obj.nr
  233.       END
  234.     wdone=wdone+cw
  235.     f=angstep*wdone
  236.     x=xx+wdone-cw/2
  237.     y=yy+amp*Sin(f)-ch/2
  238.     /* Centre char on the oval */
  239.     SetObjectCoords o page x y cw ch
  240.   END
  241. RETURN
  242. PROC group: /* Group objects [1.0] */
  243.   /* Group chars */
  244.   SelectObject
  245.   DO n=1 TO objs
  246.     SelectObject obj.n "MULTIPLE"
  247.   END
  248.   Group
  249.   objs=0
  250.   Redraw
  251. RETURN
  252. PROC bye: /* CALL bye(returnvalue)  You MUST use this instead of EXIT! [1.0] */
  253.   PARSE ARG errnr
  254.   /* Restore decimal delimitter */
  255.   IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  256.   IF lib=1 THEN CALL RemLib(library)
  257.   IF objs~=0 THEN
  258.     DO n=1 TO objs
  259.       DeleteObject obj.n
  260.     END
  261.   EXIT errnr
  262. RETURN
  263. PROC SYNTAX: /* SYNTAX & ERROR handling [1.0] */
  264.   et=ErrorText(RC)
  265. ERROR:
  266.   line=SIGL
  267.   nr=RC
  268.   IF et="" THEN et=fwerrtext.nr
  269.   IF nr>5 THEN ShowMessage 1 1 replacepat(replacepat(replacepat(errtext,"%n",nr),"%l",line),"%t",et)
  270.   CALL bye(nr)
  271. RETURN
  272. PROC rembad: PROCEDURE /* newstr=rembad(str) [1.0] */
  273.   /* Replace unprintable characters by spaces */
  274.   PARSE ARG t
  275.   bad=XRange("00"x,"1F"x)||XRange("7F"x,"9F"x)
  276.   i=Verify(t,bad,"m")
  277.   l=Length(t)
  278.   DO WHILE i>0
  279.     t=Left(t,i-1) Right(t,l-i)
  280.     i=Verify(t,bad,"m")
  281.   END
  282. RETURN t
  283. PROC replacepat: PROCEDURE /* newstr=replacepat(str,pat,replc) [1.0] */
  284.   /* Replace all occurences of a pattern in a string by another one */
  285.   PARSE ARG str,pat,replc
  286.   p=Pos(pat,str)
  287.   DO WHILE p>0
  288.     str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  289.     p=Pos(pat,str)
  290.   END
  291. RETURN str
  292. PROC getlanguage: PROCEDURE /* language=getlanguage() [1.0] */
  293.   /* Get preferred language */
  294.   ok=Open(prefs,"ENV:Locale","R")
  295.   IF ok THEN
  296.     DO
  297.       language=ReadLn(prefs)
  298.       CALL Close(prefs)
  299.     END
  300. RETURN language
  301. PROC gettexttypespecs: PROCEDURE /*  specs=gettexttypespecs() [1.0] */
  302.   Status "FONTSIZE"
  303.   p="SIZE" RESULT
  304.   Status "FONTLEADING"
  305.   p=p "LEADING" RESULT
  306.   Status "FONTWIDTH"
  307.   p=p "WIDTH" RESULT
  308.   Status "FONTOBLIQUE"
  309.   p=p "OBLIQUE" RESULT
  310.   Status "FONTPOSITION"
  311.   p=p "POSITION" RESULT
  312.   Status "FONTCASE"
  313.   p=p "CASE" RESULT
  314.   Status "FONTSTYLE"
  315.   p=p "STYLE" RESULT
  316.   Status "FONTCOLOR"
  317.   p=p "COLOR" RESULT
  318.   Status "FONTNAME"
  319.   p=p "FONT" RESULT
  320. RETURN p
  321. PROC dump: PROCEDURE /* CALL dump(var[,infostr]) [1.0] */
  322.   /* Dump a variable, %v in infostring determines it's place (debug-only) */
  323.   PARSE ARG v,info
  324.   IF info="" THEN info="%v"
  325.   ShowMessage 1 1 '"'||replacepat(info,"%v",v)||'" "" "" "Ok" "" ""'
  326. RETURN
  327.