home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / FORTH / QF251.EXE / IO.SCR < prev    next >
Text File  |  1988-09-06  |  23KB  |  1 lines
  1.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 \ Load Screen for Input/Output primitives               5 /15/882 VIEW#-T !                                                     1 9 +THRU                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       \ Devices    Terminal IO via MS-DOS                     3 /16/88CODE BDOS  ( n fun -- m )                                          BL AH MOV   DX POP   33 INT   AH AH SUB  AX BX MOV NEXT         END-CODE                                                                                                                     VARIABLE DSCR#                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  \ Cursor Routines for IBM PC Bios                       6 /12/88CODE IBM-AT   ( col row -- )  BX AX MOV                            DX POP  AL DH MOV  DSCR# #) BH MOV  2 # AH MOV                  16 INT  BX POP   NEXT   END-CODE                             CODE IBM-AT? ( -- col row )   BX PUSH  3 # AH MOV                  DSCR# #) BH MOV  16 INT   BH BH XOR  DL BL MOV                  BX PUSH DH BL MOV  NEXT  END-CODE                            CODE SCRLUP   ( left top right bot cnt attrib -- )                 DI POP   DX POP    DL DH MOV                                    AX POP  AL DL MOV  CX POP   CL CH MOV                           AX POP  AL CL MOV  DI AX MOV  SI PUSH  BP PUSH                  6 # AH MOV  16 INT  BP POP SI POP BX POP NEXT  END-CODE      : IBM-DARK  0 0 79 24 0 1536 ( $600 ) SCRLUP  ;                 CODE VIDEO-MODE? ( -- n )                                         BX PUSH   15 # AH MOV  16 INT                                   AL BL MOV 0 # BH MOV NEXT END-CODE                            \ Devices    Terminal IO via MS-DOS                   16may86GEB: (KEY?)   ( -- f )   0 11 BDOS 0<>   ;                         : (KEY)  ( -- char ) BEGIN  PAUSE  (KEY?) UNTIL  0 8 BDOS          ?DUP IF EXIT ELSE 0 8 BDOS 128 OR THEN ;                     : (CONSOLE)   ( char -- )                                          PAUSE   2 BDOS DROP   1 #OUT +!  ;                              ( changed from function call 6 to 2 to check for crtl-break)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 \ Devices                 Terminal Input and Outpu      3 /16/88HEX                                                             CODE (PR-CALL)   ( AX -- f )   BX AX MOV  0 # DX MOV                         17 INT AH BL MOV  BH BH XOR  NEXT                  : PR-STAT   ( -- f )   0200 (PR-CALL)                              DUP 20 AND ABORT" Out of paper"                                 DUP 01 AND ABORT" Printer time-out"   80 AND 0<>  ;                                                                          : PR-TYPE   ( adr len -- )   DUP #OUT +!   BOUNDS                  ?DO   BEGIN  PAUSE  PR-STAT  UNTIL                                I C@  ( 0100 OR ) (PR-CALL) DROP                              LOOP  ;                                                      DECIMAL                                                                                                                                                                                                                                                         \ Devices                     BLOCK I/O                 5 /15/88: EMIT   ( char -- )   SP@ 1 TYPE  DROP  ;                                                                                      : CRLF   ( -- )  13 EMIT   10 EMIT   #OUT OFF  1 #LINE +! ;     : BEEP   ( -- )     BELL EMIT   ;                                                                                               \ : DOS-TYPE  ( adr len -- )   DUP #OUT +!   BOUNDS             \     ?DO  I C@  PAUSE  2 BDOS DROP  LOOP  ;                                                                                    : .FILE   ( adr -- )   8 + COUNT TYPE  ;                        : FILE?   ( -- )   FILE @ .FILE  ;                              : SWITCH   ( -- )   FILE @ IN-FILE @ FILE ! IN-FILE !  ;                                                                                                                                                                                                                                                                        \ DOS                                                   5 /15/88DOS DEFINITIONS                                                 : !FILES   ( file -- )   DUP FILE !  IN-FILE !  ;               : DISK-ABORT   ( file a n -- )   TYPE ."  in "  .FILE  ABORT  ; : ?DISK-ERROR  ( file n -- )   DUP DISK-ERROR !                    IF  " Disk error" DISK-ABORT  ELSE  DROP  THEN  ;            : FSTAT   ( file -- status )  c@  ;                             : HANDLE   ( file -- handle )   1+ c@  ;                        : FVIEW   ( file -- view )  2+ @  ;                             : FSIZE   ( file -- size )   4 + 2@  ;                          FROM KDOS.SCR  OK   2 VIEW#-T !                                                                                                 : CLOSE-FILE   ( -- )    FILE @  HANDLE  FCLOSE 2DROP  ;        : CLOSE-FROM   ( -- ) IN-FILE @  HANDLE  FCLOSE 2DROP  ;        : CLOSE-BOTH  CLOSE-FILE CLOSE-FROM ;                                                                                           \ Devices                     BLOCK I/O                 5 /15/88: OPEN-FILE   ( file -- )   dup 8 + count >asciz 2 fopen .error    ( file handle ) 2dup swap 1+ c!   file-size  ROT 4 + 2!  ;   : SET-IO   ( buf-header -- adr adr b/buf handle )                  DUP 2@ ( bh f b )   swap handle dup rot                         b/buf UM*  0 LSEEK? .ERROR   2DROP                              ( h f ) SWAP 4 + @  ( f a ) tuck b/buf rot ;                 : END-IO   ( a ec flag -- )   .ERROR  DUP B/BUF <                  IF  ( a len )   b/buf swap /string ERASE                        ELSE  2DROP  THEN ;                                          : FILE-READ   ( buffer-header -- )   SET-IO  FREAD  END-IO  ;   : FILE-WRITE  ( buffer-header -- )   SET-IO  FWRITE  END-IO  ;  : FILE-IO   ( -- )                                                 ['] FILE-READ IS READ-BLOCK  ['] FILE-WRITE IS WRITE-BLOCK ;                                                                                                                                 \ Devices                     BLOCK I/O                 7 /11/88DOS DEFINITIONS                                                 HEX 80 CONSTANT DOS-ARGS   DECIMAL                              CREATE FILE1   80 ALLOT                                         FORTH DEFINITIONS                                               : DEFAULT   ( addr -- )   [ DOS ]                                  DOS-ARGS COUNT -TRAILING NIP                                    IF   file1 !FILES   DOS-ARGS  COUNT 1 /STRING                     DUP 71 > ABORT" filename too long "                             2DUP file1 8 + PLACE  >ASCIZ 2 FOPEN NIP 0=                       IF ." Can't open" BYE THEN                                    FILE1 OPEN-FILE                                               ELSE DROP THEN  ;                                            : SIZE   ( -- d )   [ DOS ]  FILE @ fsize ;                     : CAPACITY   size B/BUF UM/MOD NIP ;                            : VIEW#   FILE @ 2+  ;                                          \ MORE CHARACTER EMITTING                                       HEX                                                             : (DOS-TYPE) ( addr count handle -- )   [ DOS ]                    4000 EDOS  .ERROR DROP ;                                                                                                     : DOS-TYPE  ( addr count -- ) PAUSE  PRINTING @                   IF 2DUP  PR-TYPE                                                ELSE DUP #OUT +!  THEN  1 (DOS-TYPE)  ;                                                                                                                                                       DECIMAL                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         Load Screen for Input/Output primitives               5 /15/88  2 VIEW#-T !     store view number                               1 9 +THRU       load screens                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ Devices    Terminal IO via MS-DOS                     3 /16/88BDOS  ( n fun -- m )                                               primitive dos call                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           \ Cursor Routines for IBM PC Bios                       3 /16/88IBM-AT   ( col row -- )  force absolute cursor on an IBM screen                                                                                                                                 SCRLUP   ( left top right bot cnt attrib -- )                      scroll a part of the screen up                                                                                                                                                                                                                               IBM-DARK  darken the screen by calling scroll                   VIDEO-MODE? ( -- n )                                                return the current video mode                                                                                                                                                                                                                                                                                               \ Devices    Terminal IO via MS-DOS                   16may86GEB(KEY?)   ( -- f )  any key pushed?                              (KEY)  ( -- char ) check for a key and return,  encode special    keys as >127                                                  (CONSOLE)   ( char -- )  what you think of as emit to screen                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ Devices                 Terminal Input and Outpu      3 /16/88HEX                                                             (PR-CALL)   ( AX -- f )   printer call routine                                                                                  PR-STAT   ( -- f )   get printer status                                                                                                                                                                                                                         PR-TYPE   ( adr len -- )   type to the printer                                                                                                                                                                                                                  DECIMAL                                                                                                                                                                                                                                                         \ Devices                     BLOCK I/O                 5 /15/88EMIT   ( char -- )   emit is passed thru to type                                                                                CRLF   ( -- )  a standard carriage return and line feed         BEEP   ( -- )  emit a bell char                                                                                                                                                                                                                                                                                                 .FILE   ( adr -- )   type file name given fcb                   FILE?   ( -- )  type current file name                          SWITCH   ( -- )  switch from and to files                                                                                                                                                                                                                                                                                       \ DOS                                                   5 /15/88DOS DEFINITIONS                                                 !FILES   ( file -- )  set from and to files                     DISK-ABORT   ( file a n -- )  disk error reporting              ?DISK-ERROR  ( file n -- )  more error reporting                                                                                FSTAT   ( file -- status ) return file status                   HANDLE   ( file -- handle ) return file handle                  FVIEW   ( file -- view ) return file view number                FSIZE   ( file -- size ) return double file size                load KDOS  and then reset view#                                                                                                 CLOSE-FILE   ( -- ) close current to file                       CLOSE-FROM   ( -- ) close current from file                     CLOSE-BOTH  close both files                                                                                                    \ Devices                     BLOCK I/O                 5 /15/88OPEN-FILE   ( file -- ) open a file                                                                                             SET-IO   ( buf-header -- adr adr b/buf handle )                    set io parameters                                                                                                                                                                            END-IO   ( a ec flag -- )  clean up after a file operation                                                                                                                                      FILE-READ   ( buffer-header -- )  read block from a file        FILE-WRITE  ( buffer-header -- )  write block to a file         FILE-IO   ( -- )  set read- and write- block to file-read and      write                                                                                                                                                                                        \ Devices                     BLOCK I/O                 5 /15/88                                                                CONSTANT DOS-ARGS    a place to get default arguments           FILE1  a buffer                                                                                                                 DEFAULT   ( addr -- )  open the passed dos file                                                                                                                                                                                                                                                                                 SIZE   ( -- d )  return to file double size                                                                                     CAPACITY  return to file size in block (truncated)              VIEW#  return view# address                                                                                                                                                                     \ MORE CHARACTER EMITTING                               5 /15/88                                                                (DOS-TYPE) type to a dos file                                                                                                                                                                   DOS-TYPE  ( addr count -- ) type to the console and the printer   ( if printer is enabled )