summaryrefslogtreecommitdiff
path: root/txtile.bas
blob: 0ca914d0bf7144591b255f2359c0d192aa94a3e7 (plain)
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
10000 REM =======================================
10001 REM Quasi-textile processor
10002 REM
10003 REM INPUT - TFILE$    Textile file to read
10004 REM         HFILE$    HTML file to write
10005 REM =======================================
10010 DIM STK$(20)
10020 STKPOS = 0:CLEARALL = 0:POPSTOP = 0
10030 OPEN TFILE$ FOR INPUT AS #1
10040 OPEN HFILE$ FOR OUTPUT AS #2
10050 WHILE(NOT EOF(1))
10060     LINE INPUT#1, LTXT$
10065     PRDTXT$ = ""

10069     REM Pop if a blank line
10070     IF LEN(LTXT$) <= 0 THEN CLEARALL=1:GOSUB 11000:GOTO 10830

10079     REM Look for h1., p., bq., etc.
10080     PRDLOC = INSTR(LTXT$,".")
10083     IF PRDLOC > 1 THEN PRDTXT$ = MID$(LTXT$,1,PRDLOC-1) ELSE GOTO 10099
10085     IF PRDLOC > 3 THEN PRDLOC = -1:PRDTXT$ = "":GOTO 10099
10090     IF PRDTXT$ = "bq" OR PRDTXT$ = "p" OR MID$(PRDTXT$,1,1) = "h" THEN GOTO 10500

10099     REM Look for lists
10100     IF MID$(LTXT$,1,1) <> "*" THEN GOTO 10130 ELSE ISTAR=1:LSTTYPE$="u"
10110     WHILE(MID$(LTXT$,ISTAR+1,1) = "*"):ISTAR=ISTAR+1:WEND
10120     IF MID$(LTXT$,ISTAR+1,1) = " " THEN PRDLOC=ISTAR+1:PRDTXT$="*"+RIGHT$(STR$(ISTAR), LEN(STR$(ISTAR))-1):GOTO 10400

10129     REM Look for numbered lists
10130     IF MID$(LTXT$,1,1) <> "#" THEN GOTO 10160 ELSE ISTAR=1:LSTTYPE$="o"
10140     WHILE(MID$(LTXT$,ISTAR+1,1) = "#"):ISTAR=ISTAR+1:WEND
10150     IF MID$(LTXT$,ISTAR+1,1) = " " THEN PRDLOC=ISTAR+1:PRDTXT$="#"+RIGHT$(STR$(ISTAR), LEN(STR$(ISTAR))-1):GOTO 10400

10160     REM More tests could be here...
10170     GOTO 10600

10400     REM Process a list item
10409     REM First, check if the list is initialized
10410     GOSUB 11500

10500     REM Process the operator - dot operator - pop the whole stack!
10510     CLEARALL = 1:GOSUB 11000
10520     LTXT$ = RIGHT$(LTXT$, LEN(LTXT$) - PRDLOC)
10530     PUSHTXT$ = "##."+PRDTXT$
10540     GOSUB 11300
10550     POPSTOP = 0

10600     REM Process the text itself
10610     LI = 1:LSTART = 1:LASTC$ = " "
10620     WHILE(LI <= LEN(LTXT$))
10630         LC$ = MID$(LTXT$, LI, 1)
10640         IF LC$="_" OR LC$="*" OR LC$=CHR$(34) OR LC$="^" OR LC$="~" OR LC$="@" OR LC$="!" THEN GOTO 10650 ELSE GOTO 10800
10650         LCOPT$ = "##c"+LC$
10660         GOSUB 11200
10664         REM If we're in a link, suppress any character processing
10665         IF LCOPT$ <> LASTOP$ AND LASTOP$ = "##c!" THEN GOTO 10800
10667         REM Links must have a space preceding the !
10668         IF LC$ = "!" AND LASTC$ <> " " THEN GOTO 10800
10670         PUSHTXT$ = MID$(LTXT$, LSTART, LI-LSTART):GOSUB 11300
10680         LSTART=LI+1
10690         IF LCOPT$ = LASTOP$ AND (LCOPT$ = "##c"+CHR$(34) OR LCOPT$="##c!") AND MID$(LTXT$, LI+1, 1) = ":" THEN GOSUB 11400 ELSE LINK$ = ""
10700         IF LCOPT$ = LASTOP$ THEN CLEARALL=0:GOSUB 11000 ELSE PUSHTXT$ = LCOPT$:GOSUB 11300
10800         LI = LI + 1
10805         LASTC$ = LC$
10810     WEND
10820     IF LSTART < LEN(LTXT$) THEN PUSHTXT$=MID$(LTXT$, LSTART):GOSUB 11300
10830 WEND
10840 IF STKPOS > 0 THEN CLEARALL=1:GOSUB 11000
10850 CLOSE#1
10860 CLOSE#2
10870 ERASE STK$
10880 RETURN


11000 REM Stack pop operations sub
11001 REM If CLEARALL is 1, pop everything, otherwise, pop once
11008 IF STKPOS = POPSTOP THEN RETURN
11010 GOSUB 11200
11019 REM HTML building...
11020 IF LEN(LASTOP$) = 0 AND STKPOS > 0 THEN LASTOP$ = "##.p"
11029 REM Inline update
11030 IF MID$(LASTOP$, 1, 3) = "##c" THEN GOSUB 12000:GOTO 11050
11040 IF MID$(LASTOP$, 1, 3) = "##." THEN GOSUB 12500
11050 IF CLEARALL = 1 AND STKPOS > POPSTOP THEN GOTO 11010
11060 RETURN

11200 REM Last stack operator - search for the last stack op
11201 REM Returned as LASTOP$
11210 IF STKPOS = 0 THEN LASTOP$ = "":RETURN
11210 FOR LASTI = STKPOS TO 1 STEP -1
11220     IF LEN(STK$(LASTI)) > 3 AND MID$(STK$(LASTI),1,2) = "##" THEN LASTOP$ = STK$(LASTI):RETURN
11230 NEXT LASTI
11240 LASTOP$ = ""
11250 RETURN

11300 REM Push to the stack
11301 REM PUSHTXT$ contains the item
11310 IF LASTOP$
11310 STKPOS = STKPOS+1
11320 STK$(STKPOS) = PUSHTXT$
11330 RETURN

11400 REM Link handling
11401 REM Assumes line is in LTXT$, LI is the latest search index
11402 REM and the link is returned in LINK$
11410 ISPC = LI+2
11420 WHILE(MID$(LTXT$,ISPC,1) <> " " AND ISPC < LEN(LTXT$))
11430     ISPC = ISPC + 1
11440 WEND
11450 LINK$ = MID$(LTXT$, LI+2, ISPC - (LI+2))
11460 LI = ISPC:LSTART = LI
11470 RETURN

11500 REM List handling
11510 STKSRCH$ = "##."+LSTTYPE$+RIGHT$(STR$(ISTAR), LEN(STR$(ISTAR))-1)
11520 BACKSTK = STKPOS
11530 WHILE(BACKSTK > 0 AND STK$(BACKSTK) <> STKSRCH$):BACKSTK=BACKSTK-1:WEND
11540 IF BACKSTK > 0 THEN POPSTOP = BACKSTK:CLEARALL = 1:GOSUB 11000:GOTO 11580
11549 REM Clear the stack first - new list!
11550 GOSUB 11600:CLEARALL = 1:GOSUB 11000
11560 IF LSTTYPE$ = "u" THEN PRINT#2, "<ul>" ELSE PRINT#2, "<ol>"
11570 PUSHTXT$ = STKSRCH$:GOSUB 11300
11580 POPSTOP = STKPOS
11590 RETURN

11600 REM Parent list handling based on ISTAR
11610 BACKSTK = STKPOS
11620 WHILE(BACKSTK > 0) 
11625     IF LEN(STK$(BACKSTK)) < 4 THEN GOTO 11660
11630     IF MID$(STK$(BACKSTK), 1, 4) <> "##.u" AND MID$(STK$(BACKSTK), 1, 4) <> "##.o" THEN GOTO 11660
11640     NUM = VAL(RIGHT$(STK$(BACKSTK), LEN(STK$(BACKSTK))-4))
11650     IF NUM < ISTAR THEN GOTO 11680
11660     BACKSTK = BACKSTK-1
11670 WEND
11680 POPSTOP = BACKSTK
11690 RETURN

12000 REM Handle an inline operator
12010 BACKSTK = STKPOS:OPARG$ = ""
12020 WHILE(STK$(BACKSTK) <> LASTOP$)
12030     BACKSTK = BACKSTK - 1
12040 WEND
12050 FOR ISTK = BACKSTK+1 TO STKPOS:OPARG$ = OPARG$ + STK$(ISTK):NEXT ISTK
12060 IF LASTOP$ = "##c_" THEN PREOP$ = "<em>":POSTOP$="</em>":GOTO 12200
12070 IF LASTOP$ = "##c*" THEN PREOP$ = "<strong>":POSTOP$="</strong>":GOTO 12200
12080 IF LASTOP$ = "##c^" THEN PREOP$ = "<sup>":POSTOP$="</sup>":GOTO 12200
12090 IF LASTOP$ = "##c~" THEN PREOP$ = "<sub>":POSTOP$="</sub>":GOTO 12200
12100 IF LASTOP$ = "##c@" THEN PREOP$ = "<code>":POSTOP$="</code>":GOTO 12200
12105 IF LASTOP$ = "##c"+CHR$(34) AND CLEARALL=1 THEN PREOP$=CHR$(34):POSTOP$="":GOTO 12200
12110 IF LASTOP$ = "##c"+CHR$(34) AND LEN(LINK$) > 0 THEN PREOP$ = "<a href='"+LINK$+"'>":POSTOP$="</a>":LINK$="":GOTO 12200
12120 IF LASTOP$ = "##c"+CHR$(34) THEN PREOP$ = CHR$(34):POSTOP$=CHR$(34):GOTO 12200
12125 IF LASTOP$ = "##c!" AND CLEARALL=1 THEN PREOP$="!":POSTOP$="":GOTO 12200
12130 IF LASTOP$ = "##c!" AND LEN(LINK$) > 0 THEN PREOP$ = "<a href='"+LINK$+"'><img src='":POSTOP$="'/></a>":LINK$="":GOTO 12200
12140 IF LASTOP$ = "##c!" THEN PREOP$ = "<img src='":POSTOP$="'/>":GOTO 12200
12200 STKPOS = BACKSTK
12210 STK$(STKPOS) = PREOP$ + OPARG$ + POSTOP$
12220 RETURN

12500 REM Handle dot operator - write to output
12510 BACKSTK = STKPOS:OPARG$ = ""
12520 WHILE(BACKSTK > 0 AND STK$(BACKSTK) <> LASTOP$)
12530     BACKSTK = BACKSTK - 1
12540 WEND
12550 FOR ISTK = BACKSTK+1 TO STKPOS:OPARG$ = OPARG$ + " " + STK$(ISTK):NEXT ISTK
12555 WHILE(MID$(OPARG$, 1, 1) = " "):OPARG$ = RIGHT$(OPARG$, LEN(OPARG$)-1):WEND
12560 IF LASTOP$ = "##.p" THEN PREOP$ = "<p>":POSTOP$="</p>":GOTO 12700
12570 IF LASTOP$ = "##.bq" THEN PREOP$ = "<blockquote><p>":POSTOP$="</p></blockquote>":GOTO 12700
12580 IF LASTOP$ = "##.bc" THEN PREOP$ = "<pre><code>":POSTOP$="</code></pre>":GOTO 12700
12590 IF LASTOP$ = "##.pre" THEN PREOP$ = "<pre>":POSTOP$="</pre>":GOTO 12700
12600 IF MID$(LASTOP$,1,4) = "##.h" THEN HD$ = MID$(LASTOP$, 4, 2):PREOP$ = "<"+HD$+">":POSTOP$="</"+HD$+">":GOTO 12700
12610 IF MID$(LASTOP$,1,4) = "##.*" OR MID$(LASTOP$,1,4) = "##.#" THEN PREOP$ = "<li>":POSTOP$="</li>":GOTO 12700
12620 IF MID$(LASTOP$,1,4) = "##.u" THEN PREOP$ = "</ul>":POSTOP$="":OPARG$="":GOTO 12700
12630 IF MID$(LASTOP$,1,4) = "##.o" THEN PREOP$ = "</ol>":POSTOP$="":OPARG$="":GOTO 12700
12700 STKPOS = BACKSTK-1
12710 PRINT#2, PREOP$+OPARG$+POSTOP$
12720 RETURN