English Amiga Board


Go Back   English Amiga Board > Coders > Coders. Language > Coders. Blitz Basic

 
 
Thread Tools
Old 29 January 2016, 13:36   #1
idrougge
Registered User
 
Join Date: Sep 2007
Location: Stockholm
Posts: 3,943
New tool: ShapesInfo.rexx

Wanting to learn more about Blitz shapes files, I coded together an ARexx script that displays relevant information about each shape in a file, optionally displaying its cookiecut in a CLI window. I thought I'd post it here for testing and advice before uploading it to Aminet.
Code:
/* Display information about Blitz Basic .shapes file,
   optionally displaying the shape's cookiecut
$AUTHOR: Iggy Drougge 2016
$VER: 1.0
*/
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 pixwidth>bltsize 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 'InnehÄller ='
                     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
Put it in S: or elsewhere in your path, set the S and E bits (protect ShapesInfo.rexx SRWED) and you can run it anywhere. The command line arguments are quite obvious: FROM and TO set the starting and end numbers of the shapes to be investigated and SHOW displays the cookiecut.
Attached Files
File Type: lha ShapesInfo.lha (1.4 KB, 44 views)
idrougge is offline  
 


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools

Similar Threads
Thread Thread Starter Forum Replies Last Post
Rexx Compiler manual videofx request.Other 0 02 June 2014 19:48
Cannot open your tool Processfile.rexx paul773car New to Emulation or Amiga scene 0 12 July 2012 22:14
Updated dalf.rexx to V37+ weiju Coders. System 1 12 July 2012 21:10
suggestion for rexx GUI systmcrsh support.Apps 3 03 March 2011 17:57
New Rexx Book is Available howardfci News 0 18 June 2005 01:23

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT +2. The time now is 07:14.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2020, vBulletin Solutions Inc.
Page generated in 0.05506 seconds with 14 queries