off printload
( FILE: CCP2 -- 8 July 88 -- MFB )
( This file adds "CCP" functions to 4th/86.  The functions are:

            DIR TYPE A: B: C: D: )

  1 block drve           ( drive name)
  15 BLOCK FNSTRING      ( file name)
   1 BLOCK FNTERM        ( name terminator)
  5CH CONST CCPFCB       ( file control block)

: GCUP ( -- char)
  CONBUF 1+ B@ CONIP @ > CURCHAN @ OR IF GC ELSE 13 THEN
  DUP IF[ "a" THRU "z" ] 05FH AND THEN ;

: FNERROR ( -- )  CRLF FNSTRING ." "?" .C
  FNTERM B@ 13 = 0= IF  BEGIN GCUP 13 = END THEN CLI ;

: GETFN ( -- ) ( get filename from input stream to fnstring)
     0 25 lockio mon2 unlockio 0fh and drve b! ( get current drive into drve)
  0 FNSTRING B! 0 BEGIN DROP GCUP DUP END[ 13 33 THRU 127 ]
  REPEAT DUP 32 > OVER "=" = 0= AND WHILE
    FNSTRING B@ 1+ DUP 15 <
    IF   DUP FNSTRING B! FNSTRING + B!   ELSE  DROP DROP  THEN
    GCUP
  ENDWHILE
  FNTERM B! ;

: PARFN ( fcbadr --) ( parse filename into fcb)
   ( 4 ) drve B@ 1+ OVER B!  11 1 DO 32 OVER I + B! LOOP
  15 12 DO 0 OVER I + B! LOOP
  FNSTRING B@ 1 > FNSTRING 2+ B@ ":" = AND IF
    FNSTRING 1+ B@ DUP IF[ "A" THRU "P" ]   40H - OVER B!
                   ELSE   FNERROR  THEN
    3
  ELSE
    1
  THEN
  0 SWAP 1 SWAP FNSTRING B@ SWAP DO  ( stk: fcbadr, exflg, cnt)
    FNSTRING I + B@ DUP "." = IF
      DROP OVER OVER 1 = OR IF FNERROR THEN DROP DROP 1 9
    ELSE
      ":" = IF
        FNERROR
      ELSE
        OVER IF 12 ELSE 9 THEN OVER = IF FNERROR THEN
        FNSTRING I + B@ DUP "*" = IF
          DROP OVER IF 11 ELSE 8 THEN SWAP OVER SWAP
          DO "?" 4 PICK I + B! LOOP
        ELSE
          OVER 5 PICK + B!
        THEN
        1+
      THEN
    THEN
  LOOP
  3 KILL ;

: DOMON2 LOCKIO MON2 UNLOCKIO 255 = IF " Not Found" ." THEN ;

: WILDCHK ( fcbadr -- ) ( abort if wildcard char found in fcb)
  0 11 1 DO OVER I + B@ "?" = OR LOOP SWAP DROP
  IF FNERROR THEN ;

: TYPE
  GETFN CCPFCB DUP PARFN WILDCHK CCPFCB LOCKIO 15 MON2 UNLOCKIO
  255 = IF FNERROR THEN
  FNSTRING 1 SYSOPEN
  REPEAT DUP SYSRBYTE OVER 1AH = 0= AND GETSTS 0= AND WHILE
    .C
  ENDWHILE
  DROP SYSCLOSE ;

: DIR
  GETFN CCPFCB PARFN CCPFCB 1+ B@ 32 = IF
    " ???????????" 1+ CCPFCB 1+ 11 MOVE
  THEN
  LOCKIO 80H 26 MON1 ( set dma)
  4 ( crlf counter) CCPFCB 17 MON2 ( search for first) DUP 3 > IF
    UNLOCKIO " No File" ." DROP DROP RETURN
  THEN
  REPEAT  DUP  4 < WHILE  ( valid dir code)
    32 * 80H + ( -> entry) DUP 10 + B@ 80H AND ( get SYS flag)
    OVER 12 + B@ 31 AND ( ext flag) OR IF ( SYS or extent)
      DROP ( don't display)
    ELSE
      SWAP 1+ DUP 4 > IF
        13 2 MON1 10 2 MON1 CCPFCB B@ 40H +  2 MON1
        ":" 2 MON1 32 2 MON1 DROP 1
      ELSE
        32 2 MON1 ":" 2 MON1 32 2 MON1
      THEN
      SWAP ( stk: crlfcounter dirpointer)
      8 1 DO 1+ DUPB@ 2 MON1 LOOP
      32 2 MON1 3 1 DO 1+ DUPB@ 2 MON1 LOOP DROP
    THEN
    CCPFCB 18 MON2 ( search for next)
  ENDWHILE
  UNLOCKIO DROP DROP ;

: LOGDISK 0FH AND ( DUP 4 B@ 0F0H AND OR 4 B! ) 14 LOCKIO MON1 UNLOCKIO ;

: A: 0 LOGDISK ;
: B: 1 LOGDISK ;
: C: 2 LOGDISK ;
: D: 3 LOGDISK ; ( note -- D: in Debug renamed to DC: )