/
FILE-TYPE-stream2.f
142 lines (113 loc) · 2.92 KB
/
FILE-TYPE-stream2.f
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
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 ( îøèáêà ÷òåíèÿ )
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! \ ñòåêè íå ñáðàñûâàåì, ò.ê. ýòî çà íàñ äåëàåò CATCH :)
AGAIN
;
: 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
;
: 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
;
: TYPETOCOM ( $str count --)
com2 COMWrite ( c-addr u handle -> )
13 com2 COMOut \ ( send cr)
\ SENDKBUF 256 BLANK \ 20 PAUSE
com2 COMClear 0 buffcom !
130 PAUSE ;
: 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 2DUP TYPE CR TYPETOCOM
REPEAT DROP
R> CLOSE-FILE THROW
;
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 "
;
: TTEST-FILE ( --) \ SEND A FILE OVER SERIAL
fTest tt :setFilter
title1 tt :setTitle
tt :execute DROP
CR CR
tt :fileName TYPEFS
;