1000 REMark f16 1010 : 1020 REMark Copyright (C) 1992, 1994 Marcos Cruz (http://programandala.net) 1025 REMark Permesilo/Licencia/License: http://programandala.net/license 1030 : 1040 REMark Konstruas tekston 1050 REMark el tradicia ekrandosiero 1060 REMark de la lingvo Forth 1070 : 1080 REMark versioj: 1090 REMark 1.00 1992 06 05 1100 REMark 1.01 1994 08 1110 REMark - CLOSE anstataw CLOSE#ef 1120 REMark por finfermi, cxar alie 1130 REMark restis fajlo nefermita 1140 REMark - La fajlnomo de la programo 1150 REMark inkludas la version, kaj 1160 REMark la programo Savu registras 1170 REMark sur la uzatan diskilon, ne 1180 REMark nepre sur flp2_ 1190 REMark - Nova awtortitolo 1200 REMark - CLOSE#3 kaj CLOSE#4 1210 REMark post cxiu laborbuklo 1220 REMark - CURSEN kaj CURDIS anstataw 1230 REMark CURSOR_ON kaj CURSOR_OFF 1240 REMark - ef=5 anstataw ef=3 1250 : 1260 versio$="1.01" 1270 nullinio$=" ":REMark 16 1280 nullinio$=nullinio$&nullinio$ 1290 nullinio$=nullinio$&nullinio$ 1300 ef=5 1310 : 1320 REMark subfenestro: 1330 MODE 4 1340 WINDOW#2,512,256,0,0 1350 PAPER#2,0 1360 BORDER#2 1370 CLS#2 1380 : 1390 REMark listfenestro: 1400 WINDOW 512,150,0,0 1410 PAPER 0 1420 INK 4 1430 BORDER 4,0 1440 : 1450 REMark ordonfenestro: 1460 WINDOW#0,512,70,0,186 1470 PAPER#0,0 1480 INK#0,4 1490 BORDER#0,2,4,7 1500 : 1510 REMark erarkontrolo 1520 : 1530 REPeat cxefbuklo 1540 : 1550 titolo 1560 REPeat malfermu_1 1570 INPUT#0,"Disko kaj nomo de la ekrandosiero de Forth:",a$ 1580 IF a$="":EXIT cxefbuklo 1590 stato=FTEST(a$) 1600 SELect ON stato 1610 =-7,-9,-12,-16 1620 REPORT stato 1630 =REMAINDER 1640 OPEN_IN#3,a$ 1650 EXIT malfermu_1 1660 END SELect 1670 END REPeat malfermu_1 1680 : 1690 REPeat malfermu_2 1700 INPUT#0,"Disko kaj nomo de la nova tekstdosiero:",,b$ 1710 IF b$="":EXIT cxefbuklo 1720 stato=FTEST(b$) 1730 SELect ON stato 1740 =-8,-9,-11,-12,-16,-20 1750 REPORT stato 1760 =REMAINDER 1770 OPEN_NEW#4,b$ 1780 EXIT malfermu_2 1790 END SELect 1800 END REPeat malfermu_2 1810 : 1820 PRINT#0,"Mi laboras..." 1830 REPeat buklo 1840 IF EOF(#3):EXIT buklo 1850 linio$=nurteksto$(INPUT$(#3,64)) 1860 IF LEN(linio$) 1870 PRINT linio$ 1880 PRINT#4,linio$ 1890 END IF 1900 END REPeat buklo 1910 CLOSE#3:CLOSE#4 1920 : 1930 END REPeat cxefbuklo 1940 : 1950 fino 1960 : 1970 DEFine PROCedure fino 1980 REMark CLOSE#ef 1990 CLOSE 2000 BORDER#0 2010 WMON 2020 STOP 2030 END DEFine fino 2040 : 2050 DEFine PROCedure titolo 2060 CSIZE#0,1,0 2070 PRINT#0,"F16"!versio$ 2080 PRINT#0,"(k) Marcos Cruz, 1992, 1994" 2090 CSIZE#0,0,0 2100 PRINT#0 2110 END DEFine titolo 2120 : 2130 DEFine FuNction nurteksto$(teksto$) 2140 FOR litero=64 TO 1 STEP -1 2150 IF teksto$(litero)<>" " 2160 litero=litero+1 2170 EXIT litero 2180 END IF 2190 END FOR litero 2200 RETurn teksto$(1 TO litero-1) 2210 END DEFine nurteksto$ 2220 : 2230 DEFine PROCedure erarkontrolo 2240 WHEN ERRor 2250 OPEN#ef,con_512x25a0x156 2260 BORDER#ef,2,7 2270 CLS#ef 2280 fini=0 2290 reprovi=0 2300 eraro=ERNUM 2310 SELect ON eraro 2320 =-7 2330 REMark ne trovita 2340 PRINT#ef,"dosiero ne trovita" 2350 reprovi=1 2360 =-8 2370 REMark jam ekzistas 2380 PRINT#ef,"tiu dosiero jam ekzistas" 2390 reprovi=1 2400 =-9 2410 REMark uzata 2420 PRINT#ef,"tiu jam uzatas" 2430 reprovi=1 2440 =-11 2450 REMark plena disko 2460 PRINT#ef,"la disko tutplenas" 2470 fini=1 2480 =-12 2490 REMark negxusta nomo 2500 PRINT#ef,"la dosiernomo ne gxustas" 2510 reprovi=1 2520 =-16 2530 REMark difektita storo 2540 PRINT#ef,"la storilo estas difektita" 2550 fini=1 2560 =-20 2570 REMark nur legebla 2580 PRINT#ef,"storilo nur legebla" 2590 reprovi=1 2600 =REMAINDER 2610 REPORT#ef 2620 fini=1 2630 END SELect 2640 IF fini 2650 PRINT#ef,"Premu klavon por fini "; 2660 REMark CURSEN#ef 2670 REMark PAUSE#ef,-1 2680 REMark CURDIS#ef 2685 PAUSE -1 2690 CLOSE 2700 STOP 2710 END IF 2720 IF reprovi 2730 PRINT#ef,"Premu klavon por reprovi "; 2740 REMark CURSEN#ef 2750 REMark PAUSE -1 2760 REMark CURDIS#ef 2765 PAUSE -1 2770 BORDER#ef 2780 CLS#ef 2790 RETRY ERLIN 2800 END IF 2810 END WHEN 2820 END DEFine erarkontrolo 2830 : 2840 DEFine PROCedure savu 2850 SAVE_O "f16_"&versio$&"_bas" 2860 SAVE_O "f16_"&versio$&"_bas!" 2870 END DEFine savu