LEARNING-FORTH2020/LEARNING-FILE-TYPE.f at master · PeterForth/LEARNING-FORTH2020 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
\ LEARNING HOW TO "TYPE" A TEXT  FILE TO YOUR SCREEN
\ YOU WILL LEARN HOW TO OPEN A FILE, AND THEN READ 1 LINE + AFTER EOF

WINAPI: fopen   MSVCRT.DLL
WINAPI: fgets   MSVCRT.DLL
WINAPI: ferror  MSVCRT.DLL
WINAPI: fclose  MSVCRT.DLL
WINAPI: _fdopen MSVCRT.DLL
WINAPI: gets    MSVCRT.DLL

: R/O S" r" DROP ;

: OPEN-FILE ( addr u mode -- file ior )
  NIP SWAP fopen NIP NIP
  DUP 0=
;
: chop ( addr -- u )
  ASCIIZ> 2DUP + 1- C@ 10 = IF 1- THEN NIP
;
: READ-LINE ( addr u file -- u2 flag ior )
  ROT ROT             ( file addr u )
  SWAP fgets          ( file u addr res )
  NIP NIP             ( file res )
  ?DUP IF NIP chop TRUE 0 EXIT THEN
  0 0 ROT ferror NIP
;
: CLOSE-FILE ( file -- ior )
  fclose NIP
;
: AsStream ( h mode -- file ior )
  SWAP _fdopen NIP NIP
  DUP 0=
;
: ACCEPT ( c-addr +n1 -- +n2 ) \ 94
\  H-STDIN READ-LINE THROW DROP
  DROP gets NIP
  ?DUP IF ASCIIZ> NIP ELSE -1 THROW THEN
;
: REFILL ( -- flag ) \ 94 FILE EXT
  CURSTR 1+!
  TIB C/L
  SOURCE-ID 0 > IF SOURCE-ID ( included text )
                   READ-LINE THROW ( read 1 line  )
                   IF #TIB !
                   ELSE DROP FALSE EXIT THEN
                ELSE SOURCE-ID
                     IF 2DROP FALSE EXIT THEN ( evaluate string )
                     ACCEPT #TIB ! ( user input )
                THEN
  >IN 0! <PRE> -1
;
: MAIN1 ( -- )
  BEGIN
    REFILL
  WHILE
    INTERPRET OK
  REPEAT BYE
;
: QUIT ( -- ) ( R: i*x ) \ CORE 94
   BEGIN
    CONSOLE-HANDLES
    0 TO SOURCE-ID
    [COMPILE] [
    ['] MAIN1 CATCH
    ['] ERROR  CATCH DROP
 ( S0 @ SP! R0 @ RP! \
  AGAIN
;


\ **  TEST EXAMPLE  REPLACE  " C:\FORTHW\1.f"  WITH THE NAME OF THE FILE YOU
\     WANT TO TYPE

: TEST1
  S" C:\FORTHW\1.f" R/O OPEN-FILE THROW >R
  BEGIN
    PAD 1000 R@ READ-LINE THROW  10 PAUSE
  WHILE
    PAD SWAP TYPE CR
  REPEAT DROP
  R> CLOSE-FILE THROW
;


\ USE :     S" BLABLA.TXT "  TYPEF   to TYPE a file to your screen

:  TYPEF ( TYPE FILE )  \  S" BLABLA.TXT "  TYPEF
  ( S" C:\FORTHW\1.f" )  R/O OPEN-FILE THROW >R
  BEGIN
    PAD 1000 R@ READ-LINE THROW  10 PAUSE
  WHILE
    PAD SWAP TYPE CR
  REPEAT DROP
  R> CLOSE-FILE THROW
;


\ USE :     S" BLABLA.TXT "  TYPEFS      to TYPE a file SLOW to your screen

:  TYPEFS ( TYPE FILE SLOW )  \  S" BLABLA.TXT "  TYPEFS
  ( S" C:\FORTHW\1.f" )  R/O OPEN-FILE THROW >R
  BEGIN
    PAD 1000 R@ READ-LINE THROW  35 PAUSE
  WHILE
    PAD SWAP   TYPE CR
  REPEAT DROP
  R> CLOSE-FILE THROW
;


\ ** NOW WE ADD AN OPENDIALOG TO MAKE IT MORE AGILE **

REQUIRE OpenDialog ~day\joop\win\filedialogs.f

 \ Sample

FILTER: fTest

  NAME" all files" EXT" *.*"
  \ NAME" exe files" EXT" *.exe"

;FILTER


OpenDialog :new VALUE tt

: title1
     S" SELECT A FILE NAME TO TYPE TO THE SCREEN "
;


: RUN-TEST   ( --)   \  Open a file dialog, choose a file, and see it printed/"typed" on your screen
fTest tt :setFilter
title1 tt :setTitle
tt :execute DROP
CR CR
tt :fileName  TYPEFS
;