---

f16

Fontkodo

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

Deŝutoj

f16_bas (4.37 KiB)