Add REXX.

lib/linguist/languages.yml

@@ -3131,6 +3131,17 @@ REALbasic:
   tm_scope: source.vbnet
   ace_mode: text
 
+REXX:
+  type: programming
+  aliases:
+  - arexx
+  extensions:
+  - .rexx
+  - .pprx
+  - .rex
+  tm_scope: none
+  ace_mode: text
+
 RHTML:
   type: markup
   group: HTML

samples/REXX/BatchRemapBrushes.pprx

@@ -0,0 +1,174 @@
+/* Ga igenom lador med IFF-filer rekursivt och skapa:
+   1: Spritekartor om 320x256 med alla spritar
+   2: En tabell med enumererade spritenummer
+   Aterstar:
+   *: Att skriva shapesfiler direkt
+   $VER: 1.0
+*/
+SIGNAL ON BREAK_C
+PARSE ARG argument
+template = 'START/N COLOURS/N REMAP/S RECURSIVE/S PALETTE/K DIRECTORY/A'
+CALL Init
+
+ADDRESS 'PPAINT'
+OPTIONS RESULTS
+GetBestVideoMode WIDTH 320 HEIGHT 256 COLORS args.colours
+modeid=Word(RESULT,1)
+say modeid
+Set 'FORCE "DISPLAY=' || modeid || '"'
+IF RC~=0 THEN EXIT 20
+Set 'FORCE "IMAGEW=320" "IMAGEH=256" "COLORS='args.colours'"'
+ClearImage
+LockGUI
+ScreenToFront
+x=0 ; y=0 ; maxhoejd=0 ; fil#=0 ; blad#=0
+CALL WriteLn konstfil, ';Blad' blad#
+DO UNTIL Lines()==0 & fillista==''
+   DO WHILE fillista~=''
+      PARSE VAR fillista filnamn 'y' fillista
+      IF Right(filnamn,5)=='.info' THEN ITERATE
+      IF Word(StateF(dir||filnamn),1)=='DIR' THEN DO
+         PUSH fillista
+         PUSH dir
+         dir=dir||filnamn||'/'
+         SAY 'Entering directory' dir'...'
+         fillista=ShowDir(dir,'ALL','y')
+         ITERATE
+         END
+      LoadBrush FILE dir || filnamn NOPROGRESS
+      IF RC~==0 THEN DO
+         SAY 'Skipping file:' dir || filnamn
+         ITERATE
+         END
+      IF args.remap THEN RemapBrush NOPROGRESS
+      GetBrushAttributes WIDTH  ; bredd=RESULT
+      GetBrushAttributes HEIGHT ; hoejd=RESULT
+      GetBrushAttributes COLORS ; djup=RESULT
+      IF bredd//16==0 THEN ebwidth=bredd
+      ELSE ebwidth=bredd+(16-(bredd//16))
+      maxhoejd=Max(maxhoejd,hoejd)
+      SAY 'File:' Left(filnamn,29) 'Width:' bredd ' Height:' hoejd ' Depth:' djup ' ebwidth:' ebwidth
+      SetCurrentBrush RECTANGULAR WIDTH 1 HEIGHT 1
+      DrawRectangle x y x+ebwidth y+hoejd
+      Text fil# 'X' x+2 'Y' y+2
+      SetCurrentBrush 1 ; SetBrushHandle 0 0
+      PutBrush x y
+      CALL WriteLn(konstfil,'; '||fil# ||': '|| filnamn ||' ('||ebwidth||'x'||hoejd||'x'||djup||')')
+      CALL WriteLn(konstfil,'#'||Upper(Left(filnamn,Min(Length(filnamn),Max(LastPos('.',filnamn)-1,0))))||'='fil#)
+      x=x+ebwidth
+      IF x+ebwidth>319 THEN DO
+         x=0
+         y=y+maxhoejd
+         IF y+maxhoejd>255 THEN DO
+            SaveImage FILE 'Spritesheet' || blad# || '.ilbm' FORCE
+            IF RC==0 THEN SAY 'Saved sheet' blad#
+            ELSE SAY "Couldn't save spritesheet"
+            ClearImage
+            y=0
+            blad#=blad#+1
+            CALL WriteLn konstfil, ';Blad' blad#
+            END
+         maxhoejd=0
+         END
+      fil#=fil#+1
+      END /* WHILE fillista */
+   IF Lines()>0 THEN DO
+      PARSE PULL dir
+      PARSE PULL fillista
+      SAY 'Going back to' dir'...'
+      END
+END /* UNTIL Lines() */
+
+BREAK_C:
+FreeBrush FORCE
+UnLockGUI
+medd=fil# 'files processed in' blad#+1 'sheets'
+SAY medd
+RequestNotify 'TITLE SpriteSheet.pprx PROMPT "'medd'"'
+ScreenToBack
+CALL Close(konstfil)
+DO WHILE Lines()>0; PULL .; END
+EXIT 0
+
+Init:
+   IF argument = '' | argument = '?' THEN DO
+      SAY template
+      EXIT 0
+      END
+
+   CALL ReadArgs()
+
+   IF ~Show('L',"rexxsupport.library") THEN DO
+      IF ~AddLib("rexxsupport.library",0,-30,0) THEN DO
+         SAY 'Hittade inte rexxsupport.library'
+         EXIT 20
+         END
+      END
+   IF ~Open(konstfil,'SpriteConstants.txt','WRITE') THEN EXIT 10
+
+   IF ~SHOW('P', 'PPAINT') THEN DO
+      SAY "Couldn't find PPaint. Please start the program first."
+      EXIT 5
+      END
+   dir=args.directory
+   IF dir='""' THEN dir=Pragma('DIRECTORY')
+   IF dir='' THEN dir='Ram:Megamanv6/Graphics/'
+   IF Right(dir,1)~=='/' THEN dir=dir || '/'
+   fillista=ShowDir(dir,'FILES','y')
+   fillista=ShowDir(dir,'ALL','y')
+   IF fillista="" THEN DO
+      SAY "Found no files"
+      EXIT 5
+      END
+   IF args.colours==0 THEN args.colours=16
+   ADDRESS 'PPAINT'
+   OPTIONS RESULTS
+   IF args.palette~='' THEN LoadPalette args.palette
+RETURN
+
+ReadArgs:
+/* ReadArgs()-like evaluation of command line arguments */
+SAY 'ReadArgs'
+DO key# = 1 TO Words(Template)
+   key=Word(template,key#)
+   PARSE VAR key key "/" keytype
+   SELECT
+      WHEN keytype='S'|keytype='N' THEN args.key=0
+      WHEN keytype='K'|keytype='A' THEN args.key=''
+      OTHERWISE NOP     /* Error in template */
+      END
+   END
+
+DO WHILE argument ~= ''
+   PARSE VAR argument arg1 argument
+   arg2=''
+   DO key# = 1 TO Words(template)
+      key = Word(template,key#)
+      PARSE VAR key key '/' keytype
+      IF Upper(Left(arg1,Length(key))) = key THEN DO
+         SELECT
+            WHEN keytype='S' THEN DO
+               args.key=1
+               END
+            WHEN keytype='K' | keytype='N' | keytype='A' THEN DO
+               IF Index(arg1,'=')>0
+                  THEN DO
+                     SAY 'Innehaller ='
+                     PARSE VAR arg1 '=' arg2
+                     SAY 'arg2:' arg2
+                     END
+                  ELSE PARSE VAR argument arg2 argument
+               args.key=arg2
+               IF keytype='N' & DataType(arg2)~==NUM THEN DO
+                  SAY 'Illegal numerical argument' key arg2
+                  EXIT 10
+                  END
+               END
+            END
+            arg1=''
+            LEAVE key#
+         END
+      END
+      IF arg1~='' THEN args.directory=arg1
+   END
+RETURN

samples/REXX/ShapesInfo.rexx

@@ -0,0 +1,135 @@
+/* Display information about Blitz Basic .shapes file,
+   optionally displaying the shape's cookiecut
+$AUTHOR: Iggy Drougge 2016
+$VER: 1.1
+*/
+PARSE ARG argument
+template = 'FROM/N TO/N SHOW/S FILE/A'
+IF argument = '' | argument = '?' THEN DO
+   SAY 'ShapesInfo' template
+   EXIT 0
+   END
+
+CALL ReadArgs()
+
+IF ~Open(fh,args.file,READ) then DO
+   SAY "Couldn't Open file:" args.file
+   EXIT 10
+   END
+
+shape#=0
+filebad=0
+IF args.to=0 THEN args.to=9999
+
+IF args.from>1 THEN SAY 'Seeking...'
+DO WHILE ~EOF(fh)
+   header=ReadCh(fh,32)
+   IF EOF(fh) THEN DO
+      SAY 'Reached end of file.'
+      EXIT 0
+      END
+   PARSE VALUE header WITH pixwidth +2 pixheight +2 depth +2 ebwidth +2 bltsize +2 xhandle +2 yhandle +2 . +4 . +4 onebpmem +2 onebpmemx +2 allbpmem +2 allbpmemx +2 .
+   CALL CheckHeader
+   IF filebad THEN DO
+      SAY 'Not a valid shapes file.'
+      SAY C2X(header)
+      EXIT 10
+      END
+   shape#=shape#+1
+   bitplanesize = C2D(ebwidth) * C2D(pixheight)
+   bitmapsize = bitplanesize * C2D(depth)
+   IF shape# < args.from THEN DO
+      CALL Seek(fh,bitmapsize,CURRENT)
+      ITERATE
+      END
+   IF shape# > args.to THEN LEAVE
+   CALL PrintHeader
+   IF args.show THEN CALL ShowCookiecut
+   ELSE CALL Seek(fh,bitmapsize,CURRENT)
+   END
+EXIT 0
+
+CheckHeader:
+   IF C2D(pixwidth)>C2D(ebwidth)*8 THEN filebad=1
+   IF Left(C2B(bltsize),10)~=C2B(pixheight) THEN filebad=1
+RETURN
+
+PrintHeader:
+   SAY 'Shape #' || shape# || ':'
+   SAY '  Width:    ' C2D(pixwidth) 'pixels' '('C2D(ebwidth) 'bytes)'
+   SAY '  Height:   ' C2D(pixheight) 'pixels'
+   SAY '  Depth:    ' C2D(depth) 'bitplanes'
+   SAY '  BLTSIZE:  ' '$'C2X(bltsize) '('||,
+       C2D(B2C(Left(C2B(bltsize),10))) 'x',
+       C2D(B2C(Right(C2B(bltsize),6)))')'
+   SAY '  Handle:   ' C2D(xhandle)','C2D(yhandle)
+/*
+   SAY 'Onebpmem: ' C2D(onebpmem)
+   SAY 'OnebpmemX:' C2D(onebpmemx)
+   SAY 'Allbpmem: ' C2D(allbpmem)
+   SAY 'AllbpmemX:' C2D(allbpmemx)
+*/
+RETURN
+
+
+
+ShowCookiecut:
+   depth=C2D(depth)
+   bmap=Copies('00'x,bitplanesize)
+   DO FOR depth
+      bmap=BitOr(bmap,readch(fh,bitplanesize))
+      END
+   ln=1 ; pixheight=C2D(pixheight) ; ebwidth=C2D(ebwidth)
+   DO FOR pixheight
+      SAY C2B(SubStr(bmap,ln,ebwidth))
+      ln=ln+ebwidth
+      END
+RETURN
+
+EXIT 0
+
+ReadArgs:
+/* ReadArgs()-like evaluation of command line arguments */
+DO key# = 1 TO Words(Template) /* Initialise the keywords */
+   key=Word(template,key#)
+   PARSE VAR key key "/" keytype
+   SELECT
+      WHEN keytype='S'|keytype='N' THEN args.key=0
+      WHEN keytype='K'|keytype='A' THEN args.key=''
+      OTHERWISE NOP     /* Error in template */
+      END
+   END
+
+DO WHILE argument ~= ''
+   PARSE VAR argument arg1 argument
+   arg2=''
+   DO key# = 1 TO Words(template)
+      key = Word(template,key#)
+      PARSE VAR key key '/' keytype
+      IF Upper(Left(arg1,Length(key))) = key THEN DO
+         SELECT
+            WHEN keytype='S' THEN DO
+               args.key=1
+               END
+            WHEN keytype='K' | keytype='N' | keytype='A' THEN DO
+               IF Index(arg1,'=')>0
+                  THEN DO
+                     SAY 'Innehaller ='
+                     PARSE VAR arg1 '=' arg2
+                     SAY 'arg2:' arg2
+                     END
+                  ELSE PARSE VAR argument arg2 argument
+               args.key=arg2
+               IF keytype='N' & DataType(arg2)~==NUM THEN DO
+                  SAY 'Illegal numerical argument' key arg2
+                  EXIT 10
+                  END
+               END
+            END
+            arg1=''
+            LEAVE key#
+         END
+      END
+      IF arg1~='' THEN args.file=arg1
+   END
+RETURN

samples/REXX/SkrivShape.rexx

@@ -0,0 +1,54 @@
+/* rexx */
+PARSE ARG filnamn
+IF filnamn='' THEN DO
+   filnamn='raw'
+   filnamn='font.shapes'
+   end
+IF ~open(fil,filnamn,r) THEN EXIT 10
+pixwidth=48
+ebwidth=pixwidth/8
+pixheight=48
+depth=4
+SAY "Skriver utfil..."
+CALL open utfil,"RAM:utfil",W
+CALL skriv pixwidth,2
+CALL skriv pixheight,2
+CALL skriv depth,2
+CALL skriv ebwidth,2
+bltsize=Right(C2B(D2C(pixheight)),10,"00")
+bltsize=bltsize || Right(C2B(D2C(ebwidth)),6,"00")
+/* SAY bltsize */
+CALL skriv C2D(B2C(bltsize)),2
+CALL skriv 0,4 /* xhandle, yhandle*/
+CALL skriv 0,4 /* datapekare */
+CALL skriv 0,4 /* cookiepekare */
+CALL skriv ebwidth*pixheight,2 /* onebpmem */
+CALL skriv ebwidth*pixheight+pixheight*2,2 /* onebpmemx */
+CALL skriv ebwidth*pixheight*depth,2 /* allbpmem */
+CALL skriv ebwidth*pixheight*depth+pixheight*2*depth,2 /* allbpmemx */
+CALL skriv 0,2 /* padding */
+CALL Close utfil
+EXIT
+
+skriv:
+say "Skriver $"D2X(arg(1)) "("arg(2) "byte)"
+call writech utfil,right(D2C(ARG(1)),ARG(2),"00"x)
+return
+
+visacookie:
+   rad=copies('00'x,pixheight*ebwidth)
+   say "Initierar bitmap till" pixheight*ebwidth*depth
+   say "Ett bitplan =" pixheight*ebwidth
+   bmap.=''
+   say "laser in"
+   do bitplan=1 to depth
+      say "laser plan" bitplan
+      rad=bitor(rad,readch(fil,pixheight*ebwidth))
+      end
+   ln=1
+   say "skriver ut"
+   do for pixheight
+      say c2b(substr(rad,ln,bredd/8))
+      ln=ln+bredd/8
+      end
+return

samples/REXX/ag2xml.rexx

@@ -0,0 +1,106 @@
+/* Las en Amigaguidefil och omvandla till nan slags XML */
+/* $VER: 2 */
+options AREXX_BIFS
+options AREXX_SEMANTICS
+if ~open(infil,'Blitz2_V1.3.guide',R) then exit 10
+if ~open(utfil,'bb2.xml',W) then exit 10
+
+call writeln utfil,'<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'
+call writeln utfil,'<root>'
+radnr=1
+inrad=readln(infil)
+
+do while ~eof(infil)
+	och=1
+	do while index(inrad,'&',och)>0
+		och=index(inrad,'&',och)
+		if index(inrad,';',och)=0 then do
+			parse value inrad with prefix =(och) +1 suffix
+			inrad=prefix'&amp;'suffix
+			och=index(inrad,';',och)
+		end
+	end
+	do while index(inrad,'<')>0
+		parse var inrad prefix '<' suffix
+		inrad = prefix'&lt;'suffix
+	end
+	do while index(inrad,'>')>0
+		parse var inrad prefix '>' suffix
+		inrad = prefix'&gt;'suffix
+	end
+	inrad=behandlarad(inrad)
+	if right(inrad,1)~='>' & strip(inrad)~='' then inrad=inrad || ' '
+	testrad=inrad
+	do while index(testrad,'>') > 0
+		parse var testrad prefix '<' . '>' suffix
+		testrad = prefix || suffix
+	end
+	if length(testrad)<65 then inrad = inrad || '0d'x
+	call writech utfil,inrad
+	inrad=readln(infil)
+	radnr=radnr+1
+end
+call close(infil)
+call writeln utfil,'</root>'
+call close(utfil)
+exit 0
+
+behandlarad: procedure
+parse arg inrad
+do forever
+	if abbrev(inrad,'@NODE') then do
+		parse var inrad '@NODE ' nod inrad
+		/* say 'Hittade nod:' nod */
+		inrad='<story id="' || nod || '">' || inrad
+	end
+	if inrad='@ENDNODE' then inrad='</story>' || '0d'x
+	/* say inrad */
+	if abbrev(inrad,'-----') then inrad='<streck>	</streck>'
+	if abbrev(inrad,'Command'), 
+	| abbrev(inrad,'Function'),
+	| abbrev(inrad,'Statement') then do
+		parse var inrad kommandotyp ':' inrad
+		/* if index(inrad,'@{')>0 then */
+		parse var inrad inrad '@{' rest
+		if rest~='' then rest='@{' || rest
+		/* say 'rest:' rest */
+		inrad='<commandheadline>'||strip(kommandotyp)||'	</commandheadline><commandname>'||behandlarad(inrad)||'</commandname>'||behandlarad(rest)
+	end
+	if index(inrad,'@{')>0 then do
+		parse var inrad inrad '@{' tagg '}' rest
+		select
+			when tagg='fg shine' then tagg='<fgshine>'
+			when tagg='fg text'  then tagg='</fgshine>'
+			when tagg='b'		 then tagg='<bold>'
+			when tagg='ub'		 then tagg='</bold>'
+			/* @{" SpriteMode " link BUM_SPRITEMODE} */
+			when abbrev(tagg,'"') then do
+				parse var tagg '"' besk '"' . 'link' dest
+				tagg='<link dest="' || dest || '">' || besk || '</link>'
+			end
+			otherwise tagg='<okand>'
+		end
+		rest=behandlarad(rest)
+		/*
+			if index(rest,'@{')>0 then rest=behandlarad(left(rest,index(rest,'@{'))) || substr(rest,index(rest,'@{'))		
+		*/
+			inrad=inrad || tagg || rest
+		/* iterate */
+	end
+	if abbrev(inrad,'@') then do
+		say 'Hittade okand tagg:' inrad
+		/* inrad='<okand>' inrad '</okand>' */
+		parse var inrad '@' tagg inrad
+		if abbrev(tagg,'$') then parse var tagg '$' tagg ':'
+		inrad='<'tagg'>'inrad'</'tagg'>'
+	end
+	if abbrev(inrad,'Modes') then do
+		parse var inrad . ':' inrad
+		inrad='<modeheadline>Modes:	</modeheadline><modename>' || strip(inrad) || '</modename>'
+	end
+	if abbrev(inrad,'Syntax') then do
+		parse var inrad . ':' inrad
+		inrad='<syntaxheadline>Syntax:	</syntaxheadline><syntax>' || strip(inrad) || '</syntax>'
+	end
+	return inrad
+end