diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 56df19f3..0bca2534 100755 --- a/lib/linguist/languages.yml +++ b/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 diff --git a/samples/REXX/BatchRemapBrushes.pprx b/samples/REXX/BatchRemapBrushes.pprx new file mode 100644 index 00000000..a621ae19 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/samples/REXX/ShapesInfo.rexx b/samples/REXX/ShapesInfo.rexx new file mode 100644 index 00000000..56918a58 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/samples/REXX/SkrivShape.rexx b/samples/REXX/SkrivShape.rexx new file mode 100644 index 00000000..42e5e6d3 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/samples/REXX/ag2xml.rexx b/samples/REXX/ag2xml.rexx new file mode 100644 index 00000000..8ee3faaa --- /dev/null +++ b/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,'' +call writeln utfil,'' +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'&'suffix + och=index(inrad,';',och) + end + end + do while index(inrad,'<')>0 + parse var inrad prefix '<' suffix + inrad = prefix'<'suffix + end + do while index(inrad,'>')>0 + parse var inrad prefix '>' suffix + inrad = prefix'>'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,'' +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='' || inrad + end + if inrad='@ENDNODE' then inrad='' || '0d'x + /* say inrad */ + if abbrev(inrad,'-----') then inrad=' ' + 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=''||strip(kommandotyp)||' '||behandlarad(inrad)||''||behandlarad(rest) + end + if index(inrad,'@{')>0 then do + parse var inrad inrad '@{' tagg '}' rest + select + when tagg='fg shine' then tagg='' + when tagg='fg text' then tagg='' + when tagg='b' then tagg='' + when tagg='ub' then tagg='' + /* @{" SpriteMode " link BUM_SPRITEMODE} */ + when abbrev(tagg,'"') then do + parse var tagg '"' besk '"' . 'link' dest + tagg='' || besk || '' + end + otherwise tagg='' + 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='' inrad '' */ + parse var inrad '@' tagg inrad + if abbrev(tagg,'$') then parse var tagg '$' tagg ':' + inrad='<'tagg'>'inrad'' + end + if abbrev(inrad,'Modes') then do + parse var inrad . ':' inrad + inrad='Modes: ' || strip(inrad) || '' + end + if abbrev(inrad,'Syntax') then do + parse var inrad . ':' inrad + inrad='Syntax: ' || strip(inrad) || '' + end + return inrad +end \ No newline at end of file