Sample Macros


' CT.MACRO

' Center text on a line. Uses RBound (if active) or specified length

' Syntax:  CTnn or CTTnn / CTTnn as line commands     nn is the width to center on

'

' Author: George Deluca

'

dim tt, tt2 as string  

dim lno1, lno2, width, i as number

  if is_primary_Cmd then halt(fail, "CT macro was not invoked as a line command")


  '----- Get the line numbers

  lno1 = Get_Src1_Lptr                               ' From line

  lno2 = Get_Src2_Lptr                               ' To line

  width = Get_Src_Op                                 ' Get the centering width

  if width = 0 then width = Get_RBound               '


  for i = lno1 to lno2                               ' Loop through the line range

     if Is_Data(i) then                              ' Just Data lines

        tt = trim$(Get_Line$(i))                     ' Get the trimmed text

        if width = 0 then width = Get_Line_Len(i)    ' Use line length if no other

        if len(tt) > width then                      ' Center possible?

           Set_Msg(8, "One or more lines exceed Center length")

        else                                         '

           tt2 =  repeat$((width - len(tt)) / 2, " ") + tt ' Center it

           Set_Line(i, tt2)                          ' Stuff it back

        end if                                       '

     end if                                          '

  next                                               '

  halt                                               ' Done


------------------------------------------------------------------------------------------


' ISRBox.MACRO

' ISRBOX - Draw box with its U/L corner at the cursor

' Syntax:  ISRBOX                                     With cursor sitting on the

'                                                     desired location.  Normally the

'                                                     command would be assigned to a

'                                                     command key for convenience.

' Author: George Deluca

' Original in Rexx in the IBM macros documentation

'

dim i, j as number

if Get_Csr_LPtr = 0 then halt(FAIL, "Cursor is not within the text area")'


j = Get_Csr_LPtr                                      ' Point at 1st line

for i = 1 to 5                                        ' Set # lines to do

  if j = Get_Last_LPtr then exit for                 ' Just in case we hit bottom

  if Is_Data(j) then                                 ' Only data lines

     if i = 1 or i = 5 then                          ' If Top or bottom of box

        SPF_Ovr(j, Get_Csr_Col, "+--------------------+")  ' Overlay the box chars

     else                                            ' Else middle lines

        SPF_Ovr(j, Get_Csr_Col, "|                    |")  ' Overlay the box chars

     end if                                          '

     if i = 3 then Set_Csr(j, Get_Csr_Col + 2, 0)    ' Put cursor on middle line

  else                                               '

     Decr i                                          ' Don't move box row number

  end if                                             '

  Incr j                                             ' On to next edit line

next                                                  '

halt                                                  ' Done


------------------------------------------------------------------------------------------


' ISRCount.MACRO

'                                                                  

'  ISRCOUNT counts the number of occurrences of a string, and      

'           issues a message.                                      

'                                                                  

' Syntax: ISRCOUNT string                                          

'                                                                  

' Author: George Deluca                                            

' Original by IBM in the Macros documentation


dim msg as string

if Get_Arg$(0) = "" then halt(fail, "Missing search argument") ' Better have an operand


SPF_Cmd("FIND ALL " + SPF_Quote$(Get_Arg$(0)))        ' Issue a FIND ALL command

if Get_RC <> 0 then  halt(fail, "No occurrences of: " + Get_Arg$(1)) ' Tell of error


msg = Get_Msg$                                        ' Get the SPFLite message text

' Issue our own format message

halt("ISRCount found", Get_Arg$(0), parse$(msg, " ", 4), "times")


------------------------------------------------------------------------------------------


' ISRMask.MACRO

'

'  ISRMASK - Overlay a line with data from the mask line.

'  Use either line command O/OO or OR/ORR to specify    

'  which lines to overlay. O/OO causes nondestructive    

'  overlay, and OR/ORR causes a destructive overlay.    

'

' Author: George Deluca

' Original by IBM in the Macros Documentation

'

dim mask as string

dim i as number

spf_debug(Get_Dest_LCmd$)

if left$(Get_Dest_LCmd$, 1) <> "O" then halt(fail, "No overlay range has been selected")


mask = Get_Profile$("MASK")                           ' Fetch the MASK data


for i = Get_Dest1_LPtr to Get_Dest2_LPtr              ' Loop through line range

  if Is_Data(i) then                                 ' Only Data lines

     if Get_Dest_LCmd$ = "O" or Get_Dest_LCmd$ = "OO" then  ' Normal O/OO type overlay?

        SPF_Ovr(i, 1, mask)                          ' Overlay the mask

     else                                            ' Must be OR/ORR type

        SPF_Ovr_Rep(i, 1, mask)                      ' Force Overlay the mask

     end if                                          '

  end if                                             ' End IsData

next                                                  '

halt                                                  ' Done


------------------------------------------------------------------------------------------


' PB.MACRO

' Run a batch compile of the current program.   If the compiler reports an error,

' read the LOG file to locate the error, and move the cursor to the line in error

' and display the compiler's error message.   This demonstrates how to read and

' process an external file using the thinBasic FILE module.

'

' Syntax: PB

'

' Author: George Deluca

'

dim cmd, errmsg, tt as string  

dim errlin, errcol, i as number

dim fHandle as DWORD

uses "FILE"                                           ' Attach the FILE module


  '----- Save unmodified files

  SPF_Cmd("SAVEALL COND")


  '----- Build command line to run the compiler

  cmd = $DQ + "D:\Google Drive\Misc Data\PBWin10.bat"  + $DQ + " "

  cmd += $DQ + mid$(Get_FilePath$, 3) + $DQ + " "

  cmd += $DQ + Get_FileName$ + $DQ


  '----- Do the compile and get the RC result

  SPF_EXEC(cmd)

  if Get_RC = 0 then halt("PB10 compile successful")


  '----- Handle the compiler error, get the LOG file

  fHandle = FILE_OPEN(Get_FilePath$ + "\" + Get_FileBase$ +  ".LOG" , "INPUT")

  if fHandle = 0 then halt(fail, "PB10 compile failed, can't open LOG file")

  for i = 1 to 6                                     ' Read line 6 of the LOG

     errmsg = FILE_LineInput(fHandle)                '

  next i                                             '

  i = FILE_Close(fHandle)                            '


  '----- Extract error line number, column and error message text

  '----- Sample error line:  Error 442 in C:\Documents\Source\try.bas(12:016):  THEN expected


  tt = parse$(errmsg, any "()", 2)                   ' Get the (nnn:nnn) value

  errlin = val(tt)                                   ' Line number preceeds the :

  tt = mid$(tt, instr(tt, ":") + 1)                  '

  errcol = val(tt)                                   ' Col number follows the :  

  errmsg = parse$(errmsg, "):", 2)                   ' Message follows the ):


  '----- Issue an error message and set the cursor to the error line

  Set_Msg(fail,"Line: " + format$(errlin) + " Col: " + format$(errcol) + " " + errmsg)

  tt = Get_Line$(errlin + 1)                         ' Get the error line

  if errcol > len(tt) then                           ' Long enough to hi-lite?

     tt = lset$(tt, errcol)                          ' Lengthen it

     Set_Line(errlin + 1, tt)                        ' Stuff it back

  end if                                             '  

  Set_Csr(errlin + 1, errcol, 1)                     ' Hi-light the compiler's error location

  halt                                               ' Done


------------------------------------------------------------------------------------------


' RM.MACRO

' Find rightmost occurrence of a string

' Syntax: RM string

'

' Author: George Deluca

'

dim hicol, hiline as number value 0


if Get_Arg$(0) = "" then halt(fail, "Missing search argument")


SPF_Cmd("FIND FIRST " & Get_Arg$(0))                  ' Issue 1st FIND cmd

do while Get_RC = 0                                   ' while found

  if Get_Find_Col > hicol then                       ' Save hi-water mark

     hicol = Get_Find_Col                            '

     hiline = Get_Find_LPtr                          '

  end if                                             '

  SPF_Cmd("RFIND")                                   ' Look some more

loop                                                  '


if hiline = 0 then                                    ' Find anything?

  halt(fail, "String not found")                     ' No, tell of error

else                                                  ' Yes

  Set_Csr(hiline, hicol, Get_Find_Len)               ' Set cursor to it

  halt("Found", Get_Arg$(0), "rightmost in col:", format$(hicol)) ' Issue good message

end if                                                '


------------------------------------------------------------------------------------------



Created with the Personal Edition of HelpNDoc: Free EPub and documentation generator