From: snyder10@convex1.tcs.tulane.edu (sherry snyder)
Subject: source code for wdir.act
Nntp-Posting-Host-[nntpd-16168]: convex1.tcs.tulane.edu
Organization: Tulane University, New Orleans, LA
Date: Sat, 10 Oct 1992 05:55:27 GMT

For all you Action! programers out there, here is the source code for Wdir.act  
if you look through the code you will find many interesting tricks used to 
make this program work the way it does, plus some proc's you can add to you're
own programs...  The exit to dos proc is one...

-----8<---cut here---8<-----

;+----------------------------------+
;| PROG NAME: DIRW.ACT              |
;| VERSION #: 1.11-B                |
;|    AUTHOR: Jon D. Melbo          |
;|START DATE: 05-Jul-92             |
;|COMPL DATE: 30-Sep-92             |
;| LAST EDIT: 30-Sep-92             +---------------------------------------+
;|                                                                          |
;|PURPOSE / FUNCTION:                                                       |
;| To provide an external command for SpartaDOS which will display a "wide" |
;| directory.  The program is made to put two columns of directory on a____ |
;| 40-column screen, and four on an 80-column.  It will read the SpartaDOS_ |
;| CL for any pathname or filespec mask that may be given._________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;|                                                                          |
;|RELATED FILES LIST:                                                       |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;|                                                                          |
;|ADDITIONAL COMMENTS:                                                      |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;| ________________________________________________________________________ |
;|                                                                          |
;+--------------------------------------------------------------------------+

INCLUDE "D8:\ACT_UTIL\SYS.ACT"

MODULE ; global vars

  BYTE ARRAY Parm(29) ; this will hold the parameter
  BYTE Key_Code=764
  CARD POINTER TEMP
  CARD DOSVEC=$0A


PROC Dow_Bell() ; relocatable code block to ring a "bell"
[$A9$00$8D$08$D2$A9$30$8D$00$D2$A0
 $B0$A2$FF$8E$0A$D4$CA$D0$FA$88$8C
 $01$D2$C0$A0$D0$F0$60]


PROC Duck_Bell()
 BYTE Loop, Delay
  FOR Loop=0 TO 254
   DO
     Sound(0,Loop,10,12)
     FOR Delay=1 TO 12  DO  OD
   OD
  SndRst()
RETURN


PROC Detect_Keypress()
  Key_Code=255 ;reset key buff
  Dow_Bell()
  WHILE Key_Code=255  DO  OD
  Key_Code=255
  Duck_Bell()
RETURN


PROC Go_DOS() ; no "RETURN" is needed since we just go to DOS from here 
[$6C$0A$00]


PROC ZCRNAME(); again, no RETURN as SDX ZCRNAME has its own RTS
[$4C $FFFF]


PROC Fill_Parm()
 BYTE count=[0], chr
 DO
   chr=Peek(DOSVEC+33+count) ; may have to pre calc argument here
   IF chr<>$9B THEN
      count==+1
      Parm(count)=chr
   FI
 UNTIL chr=$9B ; char retrieved is an EOL
 OD
 Parm(0)=count ; adjust LEN byte
RETURN


PROC DirW()

  CHAR ARRAY Dir_Ln(41), ; used for reading dir
             Fld_Data(21)

  BYTE lm=82, rm=83, sw, ln=[1],
       col=[1], ec, i=[0], max_fld_cols


  lm=0 sw=rm+1 max_fld_cols=sw/20

  TEMP=ZCRNAME+1   ; point TEMP to the $FFFF operand of ZCRNAME proc

  TEMP^=DOSVEC+3  ; change the $FFFF to the real addr which is looked up
                  ; at COMTAB+3 (DOSVEC points to COMTAB)

  ZCRNAME() ; this places the next CL parameter at COMFNAM
;DEBUG NOTE- what if ZCRNAME had NO parm to process?!?!
  Fill_Parm() ; convert the EOL-ending type string at COMFNAM into a
              ; LENgth-byte string in Parm byte array

  Close(1) Open(1,Parm,198,0) ; aux1=6+64+128 (dir+attrib scan+extended)
  PutE()
  PrintE("      DirW v.1.11B      ")
  PrintE("FreeWare by Jon D. Melbo")
  ln=4
  DO
    IF EOF(1)=136 THEN EXIT FI ; end of file so quit processing dir
    i==+1
    IF i>4 ; yes, we have gotten past the dir header lines
    THEN
       FOR col=1 TO max_fld_cols
       DO
         InputSD(1,Dir_Ln)
         SCopyS(Fld_Data,Dir_Ln,1,20)
          FOR ec=1 TO 19
          DO
            IF Fld_Data(ec)=32 THEN Fld_Data(ec)= '. FI
          OD
         Fld_Data(20) = '|
         Print(Fld_Data)
       IF EOF(1)=136 THEN EXIT FI
       OD
      ln==+1
      IF ln=24 AND EOF(1)<>136 THEN
        Print("More -")
        Detect_Keypress()
        PutE()
        ln=1
      FI
    ELSE ; no! we're still on the dir header
      InputSD(1,Dir_Ln)
      PrintE(Dir_Ln)
      ln==+1
    FI
  OD
  Close(1)
  PutE()
  Go_DOS()
RETURN